# gopher.pl - an incomplete gopher gateway
#
# Sven Rudolph (sr1@irz.inf.tu-dresden.de)
# $Id: gopher.pl,v 1.19 1993/11/17 17:16:49 www Exp www $
#
# The plexus 3.0 license ( see the file NOTICE) applies.
#
# the local.conf entries :
# set     gopher_use_forms        0       # use <FORM> etc.
# set     gopher_use_internal_images  1   # use XMosaic-internal images
# map     gopher          gopher.pl       &do_gopher($rest,$query)
#
# more documentation :
# http://www.inf.tu-dresden.de/~sr1/projects/gopher.html

$map{'gopher'} = '&do_gopher($rest,$query)';

do 'sys/socket.ph';

package gopher;

$use_forms = $main'plexus{'gopher_use_forms'};
$use_internal_images = $main'plexus{'gopher_use_internal_images'};
$debug = $main'plexus{'gopher_debug'};

# $hostname comes from config file
($name, $aliases, $gopher_port) = getservbyname("gopherd","tcp");
($name, $aliases, $proto) = getprotobyname("tcp");
($name, $aliases, $type, $len, $thisaddr) = gethostbyname($hostname);

$internal_gopher_images{'0'}="internal-gopher-text";
$internal_gopher_images{'1'}="internal-gopher-menu";
$internal_gopher_images{'7'}="internal-gopher-index";
$internal_gopher_images{'8'}="internal-gopher-telnet";
$internal_gopher_images{'9'}="internal-gopher-binary";
$internal_gopher_images{'I'}="internal-gopher-image";
$internal_gopher_images{'T'}="internal-gopher-telnet";

# contains only exceptions
$gopher2mime{'text'} = "text/plain";
$gopher2mime{'text/x-dvi'} = "application/x-dvi";

#
$gopher2description{'application/postscript'} = "Postscript";
$gopher2description{'text/x-dvi'} = "DVI-File";
$gopher2description{'text/plain'} = "ASCII-Text";

$gopher2language{'en_us'} = "Englisch";
$gopher2language{'de_de'} = "Deutsch";

sub main'do_gopher {
    local($args,$query) = @_;
    local($title,$descr,$thathost,$thatport,$view,$dataflag);
    local($itemtype,$itemflag);
    local ($a,$b,$c,$d);

    $sockaddr = "S n a4 x8";

# due to a problem with plexus 3.0g
    $args =~ s/\&11/\t/g;
# due to a problem with xmosaic 2.0pre3
    $query =~ s/_/ /g;

    $http_port = ($running_as_root)? $http_defaultport:$http_userport;
    &split_selector($args);
    ($name, $aliases, $type, $len, $thataddr) = gethostbyname($thathost);

    $bestname = $thathost;

# set up socket to gopher server
    alarm($gopher_timeout);
    &connect_to_gopher();

#    &print_header();

# query extension
    if ("?" eq $itemflag) {
        # question 
        @askitems = ();
        if ("" eq $query) { # sending query form to client
            print "<ISINDEX>\n" unless $use_forms;
            &print_header();
            print "<P> This is a keyword search. </P>\n";
            print FS "$descr\t!\n";
            while (<FS>) { last if (/^\+ASK/); }
            if ($use_forms) {
                print "<PRE><FORM ACTION=>";
                $curr_nr = 0;
                while (<FS>) {
                    last if ( /^[\.\+]/ );
                    ($askkey,$askrest) = /^\W*(\w*):\W*(.*)/;
                    if ($askkey eq "Note") {
                        print "$askrest\n";
                    } elsif ($askkey eq "Ask") { 
                        ($a,$b) = split(/\t/,$askrest);
                        print $a . '<INPUT SIZE=30 VALUE="' . $b .
                              '" NAME=' . "$curr_nr$askkey>\n ";
                        $curr_nr ++;
#                    } elsif ($askkey eq "AskF") { # ask filename
#                    } elsif ($askkey eq "AskP") { # ask passord
#                    } elsif ($askkey eq "AskL") { # ask multiple lines
#                    } elsif ($askkey eq "Choose") {
#                    } elsif ($askkey eq "ChooseF") { # choose filename
#                    } elsif ($askkey eq "Select") { # on/off
#                        ($a,$b) = split(/\t/,$askrest);
#                        print "$a <INPUT TYPE=checkbox " .
#                              "NAME=$curr_nr$askkey 
                    } else {
                        print "$askkey: $askrest <INPUT SIZE=30 NAME=$i>\n";
                     }
                }
                print "To submit the query, press this button: " .
                      '<INPUT TYPE="submit" VALUE="Submit Query"> <P>'."\n";
                print "To clear the form, press this button: " .
                      '<INPUT TYPE="reset" VALUE="Clear Form">.'."\n";
                print "</PRE></FORM>";
            } else {
                 while (<FS>) {
                      last if ( /^[\.\+]/ );
                      push(@askitems,$_);
                 }
                if (1 < $#askitems) {
                     print "The search keywords for the following items ";
                     print "should be delimited by '+'\n\n";
                 } 
                 print "<PRE>";
                 foreach $i (0 .. $#askitems) {
                     @askitems[$i] =~ /\w*: *(.*)/;
                     print "$1\n\n";
                 }
                 print "</PRE>";
            } 
        } else { # receiving answer from client
            print "<P> This is the result of a keyword search. </P>\n";
            # old-style search keyword format
            if ($query =~ /^\D/) {
                # reply from XMosaic 2.0pre3
                $query =~ s/\%2B/\n/g;
                # reply from older client
                $query =~ s/\+/\n/g;
                @query = split(/\n/,$query);
            # item=value search keyword format
            } else {
                @query = split(/\&/,$query);
                $query = "";
                for $i (0 .. $#query) {
                    $query[$i] =~ s/^[^=]+=(.*)/$1/;
                }
                $query = join("\n", @query);
            }
            print FS "$descr\t?\t1\n";
            print FS "+-1\n";
            print FS "$query\n";
            print FS ".\n";
            print "<B>The search keyword";
            if ($#query == 0) { print " was"; }
            else { print "s were"; }
            print " :</B><OL>\n<LI> : " . join("<LI> : ",@query) . "</OL>\n" .
                  "<B>The result is :</B><PRE>\n";
            $_ = (<FS>);
            while (<FS>) { 
                if(/^\.\r?\n$/) { last; } else { print; }
            }
            print "</PRE>";
        }
    # text - gopher item type 0
    } elsif (($itemtype==0) || ($itemtype == 9) || ($itemtype eq "I")) {
	    if ($view ne "") {
		print FS "$descr\t" . "+$view\n";
		$_ = (<FS>) if ($itemtype == 0);
#	        print "$view, " . &gopher2mime($gopher_view) . "\n";
		&main'MIME_header('ok', &gopher2mime($gopher_view));
	        while (<FS>) { print; }
	    } else {
                @gopher_views = &get_gopher_views($itemflag,$descr);
                ($gopher_view,$gopher_language) = split(/ /,$gopher_views[0]);
                $mime_type = &gopher2mime($gopher_view);
                if ($itemflag eq "+") {
                    &main'MIME_header('ok', ($mime_type eq "text/plain") ?
                             "text/html" : $mime_type );
	        }
#                print "$gopher_view#$gopher_language#$mime_type";
                if (($mime_type eq "text/plain") && ($itemflag eq "+")) {
                &print_header;
                    print FS "$descr\n";
                    print "<PRE>"; 
                    while (<FS>) { 
			if (1) { 
			    s/&/&#38/g;
			    s/</&#60/g;
			    s/>/&#62/g;
			    print;
			}
		    }
		} else {
		    print FS "$descr";
		    if ($itemflag eq "+") { print FS "\t" ."+$gopher_view $gopher_language"; }
		    print FS "\n";
		    $_ = (<FS>) if ($itemflag eq "+");
		    while (<FS>) { print; }
		}
		if ($mime_type eq "text/plain") { print "</PRE>"; }

	}
    # directory
    } elsif ($itemtype==1) {
        &main'MIME_header('ok', 'text/html');
        &print_header;
        &read_directory;
    #} elsif ($itemtype==2) { # CSO phone-book
    # error occured - gopher item type 3
    } elsif ($itemtype==3) {
        &main'MIME_header('ok', 'text/plain');
        print "This is said to be an error message ;-)";
    #} elsif {$itemtype==4) { # BinHexed Macintosh file
    #} elsif {$itemtype==4) { # DOS binary archive
    #} elsif {$itemtype==4) { # uuencoded file
    # index serch
    } elsif ($itemtype==7) {
        &main'MIME_header('ok', 'text/html');
        &print_header;
        # question 
        @askitems = ();
        if ("" eq $query) {
            print "<ISINDEX>";
            print "A long result list may take more time ! </P>";
        } else { #answer
            print "<ISINDEX>";
            print "trying to answer the request\n";
            print FS "\n$query\r\n";
            &read_directory;
        }
    # telnet session - gopher item type 8
    } elsif ($itemtype==8) {
        &main'MIME_header('ok', 'text/html');
        print "This is a telnet session ;-)<P>" .
              "If you got this URL from the gopher-to-html gateway, " .
              "it is a bug";
    # binary - gopher item type 9
	# see item type 0
    }
    close(FS);
#    print "</BODY>\n";
}

sub print_header {
    ($a,$b,$c,$d) = unpack('C4',$thataddr);
    print "<HEADER>\n";
    print "<TITLE>Gopher at $bestname, Port $thatport</TITLE>\n</HEADER>\n";
    print "<BODY>\n";
    if ($descr =~ /^.\/$/) {
        print "<H1>Root gopher server</H1>\n";
    } else {
        print "<H1>$title</H1>\n";
    }
    print "gopher server at $bestname, port $thatport\n<P>\n";
    if ($debug)  {
        print "<PRE>\n";
        print "Address: $thathost Port: $thatport, Type : $itemtype , ";
        print "Itemflag : $itemflag \n";
        print "Description : $descr \n";
        print "Queries : $query\n" if $itemflag eq "?";
        print "\n</PRE>\n";
    }
}

sub read_directory {
    print "<PRE>";
    print "<UL>\n" unless $use_internal_images;
    if ($itemflag ne "+") { 
        print FS "$descr\n";
        @views = (" ");
        while (<FS>) {
            next if (/^\./);
            chop;chop;
	    &split_selector($_);
            &print_anchor();
        }
    } else {
        print FS "$descr\t+application/gopher+-menu\n";
        $state_begin = 0;
	$state_pending = 1;
        $state_views = 2;
        $state_other = 3;
	$state = $state_begin;
        $reading_views = 0;
        while (<FS>) {
            chop; chop;
            $line = $_;
            if ( ($line =~ /^([\+])(\w*):(.*)$/) || 
                 ($line =~ /^(\.)/) ) {
		$flag = $1;
                $key = $2;
                ($rest) = $3 =~ /^ *(.*)$/;
#		print "-$key- ";
		if ( ($key eq "INFO") || ($flag eq ".") ) {
#                    print ":$rest<P>\n";
#                    print "State : $state<P>\n";
                    if ($state == $state_pending) { # no views specified
			@views = (" ");
			&print_anchor();
		    } elsif ($state == $state_views) {
			if ($#views == 0) { # one view specified
#			    @views = (" $view: ");
			    &print_anchor();
			} else { # multiple views specified 
                            &print_anchor();
			}
		    }
                    &split_selector($rest);
                    $state = $state_pending;
		    $reading_views = 0;
		    @views = ();
                } elsif ($key eq "VIEWS") {
                    $state = $state_views;
                    $reading_views = 1;
                } else {
                    $reading_views = 0;
                }
            } else {
                if ( ( $reading_views ) &&
                     ( ($state == $state_views) || 
                       ($state == $state_pending) ) ) {
                    ($line) = $line =~ /^ *([^:]*)/;
                    unshift(@views, $line);
#                    print "view : $line<P>";
                } else {
#                    print "data : $line<P>";
		}
	    }
#          print "<P>\n";
        }
    }
    print "</UL>\n" unless $use_internal_images;
    print "</PRE>";
}

sub print_anchor {
    $ptitle = &encapsulate_for_url($title);
    $pdescr = &encapsulate_for_url($descr);
    $pitemflag = &encapsulate_for_url($itemflag);
    if ($use_internal_images) {
        print '<IMG SRC=' . 
              ( ($itemflag eq "?") ? 
                 $internal_gopher_images{'7'} :        
              ( $internal_gopher_images{$itemtype} || 
                "internal-gopher-unknown" ) ) . "> ";
    } else { print "<LI>"; }
    if (($itemtype eq "8") || ($itemtype eq "T")) {
        print '<A HREF="' . (($itemtype eq "8")?"telnet":"tn3270") .
	    '://' . "$pdescr";
        if ($pdescr ne "") { print "@"; }
        print "$addr:$port/" . '">' .
	      &encapsulate_for_html($title) ."</A>\n";
    } elsif (($#views == 0) || ("1" eq substr($descr,0,1)) || ("" eq $descr)){
        $pview = &encapsulate_for_url($view[0]);
        print "<A HREF=/gopher/$itemtype$ptitle&11$pdescr" .
              "&11$thathost&11$thatport&11$pitemflag" .
              "$pview&11$dataflag";
	if ($itemflag ne "+") { print "&11$pdescr";}
        print ">" . &encapsulate_for_html($title) . "</A>";
    # mark directories with /
        if (("1" eq substr($descr,0,1)) || ("" eq $descr)) { print "/"; }
        print "\n";
    } else {
#        print "Views : #",join('#',@views), "#<P>\n";
	print &encapsulate_for_html($title) . "\n   (";
        foreach $view (@views) {
            $pview = &encapsulate_for_url($view);
            ($gopher_view,$gopher_language) = split(/ /,$view);
            print "<A HREF=/gopher/$itemtype$ptitle&11$pdescr" .
                  "&11$thathost&11$thatport&11$pitemflag" .
                  "$pview&11$dataflag>";
            print &gopher2description($gopher_view) ;
	    print ",";
            print &gopher2language($gopher_language) ;
            print "</A>; ";
        } 
        print ")\n";
    }
}

sub connect_to_gopher {
    local($this) = pack($sockaddr, &main'AF_INET, 0, $thisaddr);
    local($that) = pack($sockaddr, &main'AF_INET, $thatport, $thataddr);
    socket(FS, &main'AF_INET, &main'SOCK_STREAM, $proto) ||
        &error('internal_error', "socket: $!");
    bind(FS, $this) || &main'error('internal_error', "bind: $!");
#connect to gopher server
    connect(FS, $that) || &main'error('internal_error', "connect 1: $!");
    select((select(FS), $| = 1)[0]);
};

sub get_gopher_views {
    local($itmeflag, $descr) = @_;
    local($a, @gopher_views);
    if ( $itemflag ne "+") { # no gopher+
        @gopher_views = ();
    } else {
        print FS "$descr\t!\n";
        while (<FS>) { last if (/^\+VIEWS/); }
        while (<FS>) {
            last if (/^\+/);
            y/A-Z/a-z/;
            push(@gopher_views,/^ *([^:]*)/);
        }
        shutdown(FS,2);
        &connect_to_gopher();
    }
    @gopher_views;
}


sub split_selector {
    local($line) = @_;
    ($title,$descr,$thathost,$thatport,$view,$dataflag) = 
	split(/\t/,$line);
    $itemtype = (length($title)) ? substr($title,0,1) : "1";
    $title = substr($title,1);
    if (length($descr) == 0) { $descr = "1/" };     
    if (length($descr) == 1) { $descr = "$descr/" };
    $itemflag = substr($view,0,1);
    $view = substr($view,1);
    ($gopher_view,$gopher_language) = split(/ /,$view);
#    ($itemtype,$title,$descr,$thathost,$thatport,$itemflag,$view,$dataflag); 
}

sub encapsulate_for_html {
    local($_) = @_;
    s/([\&<>])/sprintf('&#%02u',ord($1))/eg;
    $_;
}

sub encapsulate_for_url {
    local($_)= @_;
    &main'printable($_);
    s/>/%3E/g;
    s/\?/%3F/g;
    s/ /%20/g;
    $_;
}

sub gopher2mime {
    $_ = @_[0];
    tr/A-Z/a-z/;
    $gopher2mime{$_} || $_;
}

sub gopher2description {
    $_ = @_[0];
    tr/A-Z/a-z/;
    $gopher2description{$_} || $_;
}

sub gopher2language {
    $_ = @_[0];
    tr/A-Z/a-z/;
    $gopher2language{$_} || $_;
}
1;