#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#               "End of shell archive."
# Contents:  goform test.form
# Wrapped by riddle@rio-grande on Mon Jul 25 13:41:58 1994
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'goform' -a "${1}" != "-c" ; then
 echo shar: Will not clobber existing file \"'goform'\"
else
echo shar: Extracting \"'goform'\" \(12068 characters\)
sed "s/^X//" >'goform' <<'END_OF_FILE'
X#!/usr/local/bin/perl
X#
X# goform -- crude telnettable Gopher form fillout daemon
X#
X# History:
X# PASR 03/09/93        Original version (release 0.1) by Prentiss Riddle,
X#              [email protected].
X# PASR 03/29/93        Use CRLF on output to user, to make Macs and PCs happy;
X#              explicitly send an IAC WONT ECHO so Mac telnet clients
X#              will know that they have to echo locally.
X# PASR 04/02/93 Added "Reply-To" handling.  Declared this version 0.2.
X#
X#-------------------------------------------------------------------------
X#
X# INSTALLATION:
X#
X# The goform program should be executed from inetd with the name of the
X# form file as an argument.  In order to have multiple goform forms
X# available, each should be assigned a separate port.  An example SunOS
X# 4.1.2 installation:
X#
X# Files installed:
X#      /foo/cwis/bin/goform            executable
X#      /foo/cwis/etc/widget.form       Widget Request form
X#      /foo/cwis/etc/suggest.form      Suggestion Box form
X#
X# Added to /etc/services (be sure to make yp afterward):
X#    goform10003      10003/tcp           # gopher form: widget request
X#    goform10004      10004/tcp           # gopher form: suggestion box
X#
X# Added to /etc/inetd.conf (be sure to HUP inetd afterward):
X#    goform10003      stream  tcp     nowait  nobody    /foo/cwis/bin/goform        goform /foo/cwis/etc/widget.form
X#    goform10004      stream  tcp     nowait  nobody    /foo/cwis/bin/goform        goform /foo/cwis/etc/suggest.form
X#
X#
X# FORMFILE FORMAT:
X#
X# The first few lines of the formfile specify header lines which will be
X# used to mail off the results after the form is filled out, as follows:
X#
X#      To: recipient-address
X#      Subject: subject-line
X#      Reply-To: return-address
X#
X# The recipient address must be fixed but the subject line and the return
X# address may contain field specifications in the form of a '$' character
X# followed by an integer.  These will be expanded to include the
X# user's answers to the correspondingly numbered questions.  The Reply-To
X# line is optional; if it is omitted, a "Reply-To:" line will appear in
X# the mail header with no argument.  Note that the program doesn't do any
X# error checking of the address specified in the Reply-To field, so
X# recipients should use care in replying.
X#
X# The remainder of the formfile specifies the form to be filled out.
X#
X# Lines containing a '[' are interpreted as questions.  Characters following
X# the '[' are taken to be a default value for the answer.  Characters
X# preceding the '[' are taken to be a prompt.  If there is no prompt
X# preceding the '[', the question is taken to be a running essay questions
X# and multiple lines of input are accepted until a blank line or a line
X# consisting of a single '.' is read.
X#
X# Non-question lines in the formfile are displayed to the user and/or
X# displayed together with the user's answers in the results sent by mail:
X# -- Lines beginning in '>' are displayed to the user but not mailed.
X# -- Lines beginning in '<' are mailed but not displayed to the user.
X# -- Lines beginning in '#' are comments and are ignored.
X# -- Lines containing no '[' and not beginning in '>', '<' or '#' are both
X#      displayed to the user and mailed.
X#
X#
X# EXAMPLE FORMFILE:
X#
X# To: [email protected]
X# Subject: Widget request from $2 ($1)
X# Reply-To: $1
X# # Test form.  This is a comment.
X#                           WIDGET REQUEST FORM
X# >
X# >Widget Services supplies widgets only to registered students, faculty
X# >and staff of Foobar University.
X# >
X# >To pick up your widget go to Room 101 between the hours of 1-2 pm
X# >Monday through Wednesday.
X#
X# Personal info (e-mail address, name, office address, extension):
X#   E-mail address: [
X#             Name: [
X#   Office address: [
X#        Extension: [
X#
X# Widget shape (round, square, triangular -- CHOOSE ONE):
X#        Round: [n
X#       Square: [n
X#   Triangular: [n
X#
X# Number of widgets desired: [1
X#
X# What additional features would you like to see in a widget?
X# [
X#
X# <--------------------------------------------------------------------
X# <                          FOR OFFICE USE ONLY
X# <
X# < Processed by: ____________________________   Date: ________________
X# <
X# < Comments: _________________________________________________________
X# <--------------------------------------------------------------------
X#
X#-------------------------------------------------------------------------
X# Global variables:
X#  $ReplyTo   "Reply-To:" line
X#  $Subject   "Subject:" line
X#  $To        "To:" line
X#  $def       are there any default answers in @ans?
X#  $formfile  name of the file from which form will be taken
X#  $mailer    mail delivery program
X#  $nans      number of answers in @ansindex (and possible answers in @ans)
X#  $nl        number of lines in @lines
X#  @ans       answers from user (may be predetermined defaults)
X#  @ansindex  table to look up Nth answer in @ans (since @ans is sparse)
X#  @lines     lines in form
X#  @question  array of flags: does this line (in @lines) ask a question?
X#  FORM       file handle for form file
X
X#-------------------------------------------------------------------------
X
Xrequire("ctime.pl");
X
X$mailer = "/bin/mail";
X$usage = "usage: goform formfile";
X
X# Parse command-line arguments.
Xdie("$usage\n") unless ($#ARGV == 0);
X$formfile = $ARGV[0];
X
X# Immediately flush all output to STDOUT.  Send an "IAC WONT ECHO" string
X# (per RFCs 1184 and 857) so the Mac client will know it has to echo text
X# locally.  Then throw away an initial line of input in order to dispose of
X# any remaining telnet protocol cruft.
X$| = 1;
Xprint("\377\374\001\n");                       # IAC WONT ECHO
Xprint("Press return to begin:\r\n");
X$whatnow = <STDIN>;
Xprint("\r\n\r\n\r\n\r\n");
X
X&parseform();
X
Xdo {
X       &makepass();
X
X       do {
X               print("\r\nSave/Cancel/Revise (s/c/r)? ");
X               $whatnow = <STDIN>;
X               $whatnow =~ tr/A-Z/a-z/;
X       } until($whatnow =~ /^\s*(s|save|c|cancel|r|revise)\s*$/);
X       if ($whatnow =~ /^\s*(c|cancel)\s*$/) {
X               print("Cancelling...")
X               &sleep(1);
X               exit(0);
X       }
X       print("\r\n\r\n\r\n\r\n");
X} until ($whatnow =~ /^\s*(s|save)\s*$/);
X
X$Subject = &fixfields($Subject);
X$ReplyTo = &fixfields($ReplyTo);
X
X&sendform();
X
X#-------------------------------------------------------------------------
X# clean -- remove leading and final whitespace from a string.
X#
X# usage: $str = &clean($str);
X
Xsub clean {
X       local($str) = @_;
X       $str =~ s/^\s*//;
X       $str =~ s/\s*$//;
X       return($str);
X}
X#-------------------------------------------------------------------------
X# fixfields -- fill out "$N" items in Subject and Reply-To lines with
X#              corresponding answers
X#
X# Global variables used:  $ans  $ansindex
X
Xsub fixfields {
X       local($oldsubj) = @_;
X       local($l, $newsubj, $s);
X
X       # Step through the Subject line.  When you find a "$n", substitute
X       # the corresponding answer field.
X       $newsubj = $oldsubj;
X       while ($newsubj =~ s/\$(\d*)/$ans[$ansindex[$1 - 1]]/e) {
X               # do nothing
X       }
X       return($newsubj);
X}
X#-------------------------------------------------------------------------
X# Make a pass through the form.
X#
X# Global variables used:
X
Xsub makepass {
X       local($char, $l, $resp);
X
X#      # Remind the user how defaults work (unless this is the first
X#      # pass and there are none).
X#      if ($def) {
X#              print("\r\nNOTE:\r\n");
X#              print("To accept pre-defined values (in []), press return.\r\n");
X#              print("To delete a pre-defined value, type a space.\r\n\r\n");
X#      }
X#      $def = 1;
X
X       # Loop through the lines in the form.
X       for ($l = 0; $l < $nl; $l++) {
X
X               # Is there a question associated with this line?
X               if ($question[$l]) {
X                       # Do we have a default answer for this question?
X                       if ($ans[$l]) {
X                               printf("$lines[$l]<$ans[$l]> ");
X                       } else {
X                               print("$lines[$l]");
X                       }
X                       # Is this a run-on essay question? (Is there a prompt?)
X                       if ($lines[$l]) {
X                               # No, get a single answer.
X                               $resp = <STDIN>;
X                               $resp =~ s/[\r\n]*$//;
X                               $ans[$l] = &clean($resp) if ($resp);
X                       } else {
X                               # Yes, it's a run-on question  -- accept
X                               # multiple lines in a single answer.
X                               print("\r\n") if ($ans[$l]);
X                               print("(Enter a blank line to finish.)\r\n");
X                               $resp = <STDIN>;
X                               $resp =~ s/[\r\n]*$//;
X                               if ($resp) {
X                                       $ans[$l] = "";
X                                       do {
X                                               $ans[$l] .= &clean($resp) . " ";
X                                               $resp = <STDIN>;
X                                               $resp =~ s/[\r\n]*$//;
X                                       } while ($resp);
X                               }
X                       }
X               } else {
X                       # This isn't a question -- print it unless it's
X                       # intended only for the final mail.
X                       $char = substr($lines[$l], 0, 1);
X                       next if ($char eq "<" | $char eq '#');
X                       if ($char eq ">") {
X                               print(substr($lines[$l], 1), "\r\n");
X                       } else {
X                               print("$lines[$l]\r\n");
X                       }
X               }
X       }
X}
X#-------------------------------------------------------------------------
X# mmddyy -- return date in the form "mm/dd/yy"
X#
X# Portability issue: we count on &ctime() to return the date in one of
X# the two following formats:
X#
X#       Wed Feb 24 10:42:22 1993
X#       Wed Feb 24 10:42:22 CST 1993
X#
X# If it doesn't, we're in trouble...
X
Xsub mmddyy {
X       local($date, $dd, $mm, $yy);
X
X       $date = &ctime(time);
X       ($yy) = $date =~ /\s\d\d(\d\d)\s*$/;
X       $mm = &monthindex(substr($date, 4, 3));
X        $dd = substr($date, 8, 2);
X        $dd =~ s/ /0/;
X       return("$mm/$dd/$yy");
X}
X#--------------------------------------------------------------------------
X# monthindex -- given a three-character month abbreviation, return the
X#               corresponding integer "01" (January) to "12" (December)
X#
X# usage: $mm = &monthindex($monthstr);
X# error: return -1 in case of error;
X
Xsub monthindex {
X        local($monthstr) = @_;
X        local($mm);
X        $monthstr =~ tr/A-Z/a-z/;
X        $mm = index("janfebmaraprmayjunjulaugsepoctnovdec", $monthstr) / 3 + 1;
X        $mm = -1 if ($mm <= 0 || $mm > 12);
X        $mm = "0" . $mm if ($mm > 0 && $mm < 10);
X        return $mm;
X}
X#-------------------------------------------------------------------------
X# Parse the form.
X#
X# Global variables used:      FORM
X# Global variables modified:  $ReplyTo  $Subject  $To  $ans  $ansindex
X#                             $def  $formfile  $nans  $nl  $lines  $question
X
Xsub parseform {
X       local($_);
X
X       open(FORM, "< $formfile") || die("Can't open form $formfile");
X
X       $nans = 0;
X       $nl = 0;
X       $def = 0;
X       while ($_ = <FORM>) {
X               chop($_);
X
X               # Discard comments.
X               next if (/^#/);
X
X               # Find first instances of header lines.
X               if (!$ReplyTo && /^Reply-To:\s+(\S.*)/) {
X                       $ReplyTo = $1;
X                       next;
X               }
X               if (!$Subject && /^Subject:\s+(\S.*)/) {
X                       $Subject = $1;
X                       next;
X               }
X               if (!$To && /^To:\s+(\S.*)/) {
X                       $To = $1;
X                       next;
X               }
X
X               # Determine which lines contain input markers ("[") and of
X               # those, which contain predetermined defaults.
X               if (/^(.*)\[(.*)\]?$/) {
X                       $question[$nl] = 1;
X                       $lines[$nl] = $1;
X                       $ans[$nl] = $2;
X                       $ansindex[$nans] = $nl;
X                       $nans++;
X               } else {
X                       $lines[$nl] = $_;
X               }
X               $nl++;
X       }
X}
X#-------------------------------------------------------------------------
X# sendform -- mail the resulting form off to the recipients defined in the
X#             "To:" line.
X#
X# Global variables used:  $ReplyTo  $Subject  $To  $ans  $lines  $mailer  $nl
X
Xformat MAIL =
X^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
X$line
X~~^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
X  $line
X.
Xsub sendform {
X       local($char, $l, $line, $s);
X
X       print("Sending...\r\n");
X
X       # Open the mail process
X       $To =~ s/'//g;                  # sanitized for your protection
X       open(MAIL, "| $mailer '$To'")
X               || die("unable to open mailer $mailer to $To");
X
X       print(MAIL "Subject: $Subject\r\nReply-To: $ReplyTo\r\n\r\n");
X
X       print(MAIL "Date: " . &mmddyy() . "\r\n");
X
X       for($l=0; $l<$nl; $l++) {
X               # Skip lines intended only for the user.
X               $char = substr($lines[$l], 0, 1);
X               next if ($char eq ">" | $char eq '#');
X               if ($char eq "<") {
X                       # This line intended only for mail recipient.
X                       $line = substr($lines[$l], 1);
X               } elsif ($lines[$l]) {
X                       # Normal line -- may include an answer.
X                       $line = $lines[$l] . $ans[$l];
X               } else {
X                       # Indent lines with no question.
X                       $line = "  " . $ans[$l];
X               }
X               write(MAIL);
X       }
X       close(MAIL);
X}
X#-------------------------------------------------------------------------
X# end of goform script
END_OF_FILE
if test 12068 -ne `wc -c <'goform'`; then
   echo shar: \"'goform'\" unpacked with wrong size!
fi
chmod +x 'goform'
# end of 'goform'
fi
if test -f 'test.form' -a "${1}" != "-c" ; then
 echo shar: Will not clobber existing file \"'test.form'\"
else
echo shar: Extracting \"'test.form'\" \(1041 characters\)
sed "s/^X//" >'test.form' <<'END_OF_FILE'
XTo: [email protected]
XSubject: Widget request from $2 ($1)
XReply-To: $1
X# Test form.  This is a comment.
X                          WIDGET REQUEST FORM
X>
X>Widget Services supplies widgets only to registered students, faculty
X>and staff of Foobar University.
X>
X>To pick up your widget go to Room 101 between the hours of 1-2 pm
X>Monday through Wednesday.
X
XPersonal info (e-mail address, name, office address, extension):
X  E-mail address: [
X            Name: [
X  Office address: [
X       Extension: [
X
XWidget shape (round, square, triangular -- CHOOSE ONE):
X       Round: [n
X      Square: [n
X  Triangular: [n
X
XNumber of widgets desired: [1
X
XWhat additional features would you like to see in a widget?
X[
X
X<--------------------------------------------------------------------
X<                          FOR OFFICE USE ONLY
X<
X< Processed by: ____________________________   Date: ________________
X<
X< Comments: _________________________________________________________
X<--------------------------------------------------------------------
END_OF_FILE
if test 1041 -ne `wc -c <'test.form'`; then
   echo shar: \"'test.form'\" unpacked with wrong size!
fi
# end of 'test.form'
fi
echo shar: End of shell archive.
exit 0

You are viewing proxied material from gopher.meulie.net. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.