#!/usr/local/bin/perl # freeport.pl -- Common routines for freeport gateway and # Freeport CGI/file translator # # Original by mcr@sandelman.ocunix.on.ca # # Continued development: russell@flora.ottawa.on.ca # $Id: freeport.pl,v 1.1 1998/10/06 00:47:48 tygerwww Exp $ # See http://www.flora.ottawa.on.ca/flora/server/freeport.html # for more information. sub bbtelnet { #print STDERR "TELNET: @_\n"; local($sel,$_)=@_; s/bbtelnet\s*//; # turn into a Telnet URL $host=undef; $port=undef; ($host,$port) = split; $port = 23 if(!defined($port)); if ($port == 23) { print "
  • $sel\n"; } else { print "
  • $sel\n"; } } require 'shellwords.pl'; # @words = &shellwords($line); # html_head and html_foot should be moved to include sub html_head { local($title,$headcomments)=@_; < $headcomments $title EOF } sub html_foot { <

    [FLORA HOME] [Help Desk] [Flora FAQ] [Sponsors] EOF } sub fix_url { local($directory) = @_; local($i)=0; local(@url_parts) = split('/',$directory); while ($i <=$#url_parts) { if ($url_parts[$i] eq '.') { splice(@url_parts,$i,1); } elsif ($url_parts[$i] eq '..') { if ($i > 0) { splice(@url_parts,$i-1,2); $i--; } } else { $i++; } } return(join('/',@url_parts)); } sub gopher { local($eline,$pline) = @_; #print STDERR "Gopher: '$eline' '$pline'\n"; # turn into a gopher URL $host=undef; $port=undef; $hostorURL=undef; $path=undef; @pline = &shellwords($pline); shift(@pline); # get rid of gopher command word while($arg = shift @pline) { # print STDERR "Arg: $arg
    \n"; # Handle: -p"no blank after dash p argument" if ( $arg =~ /^-.\S/ ) { unshift(@pline,$arg =~ /^(-.)(.*)/); next; } if ( $arg eq '-p' ) { $path = shift(@pline); $path = "/1$path"; next; } if ( $arg eq '-t' ) { $title = shift(@pline); next; } if ( $arg eq '-T' ) { $type = shift(@pline); next; } if ( $arg eq '-i' ) { $search = shift(@pline); next; } next if $arg =~ /^-/; if ( !defined($hostorURL) ) { $hostorURL=$arg; next; } if ( !defined($port) ) { $port=$arg; next; } } if ( $hostorURL =~ /^\w+:\/\// ) { # item is an URL, not a host name print "

  • $eline\n"; } else { $hostorURL =~ s/\s+//g; $hostorURL = "freenet.carleton.ca" if $hostorURL eq ''; $port = 70 if !defined($port); print "
  • $eline\n"; } } sub newsreader { local($sel,$_)=@_; # take last argument s/^.*\s(\S+)$/$1/; print "
  • $sel\n"; } sub more { local($sel,$_)=@_; s/\%/%25/g; # replace all % with %25 code # print "
    Pat: $_\n"; s/\"\+\/(\S*)\s(.*)\"/\"\+\/\1%20\2\"/g; # print "
    Pat2: $_\n"; @args=split; shift @args; $pat=undef; $file=undef; foreach (@args) { s/\"//g; if(/^\+/) { if(/^\+\/([^\/]*)/) { $pat=$1; $pat =~ s/\/%3e/g; # print "
    Pat: $pat\n"; } } else { $file=$_; } } if(!defined($file)) { print "
  • Bad p line. Sorry: $file | $pat.\n"; } else { if(defined($pat)) { print "
  • $sel\n"; } else { print "
  • $sel\n"; } } } # Accepts filename and output filehandle as parameters sub translate_freeport { local($file) = @_; local( $n, $i ); if( -f "$file" ) { open(IN,$file) || &main'error('not_found', "document \`\`$file\'\' cannot be opened: $!"); &main'MIME_header('ok', 'text/html'); # Find a title... find_title: while(){ next if /^(\#|\s*$)/; # Don't copy comments or blank lines s/^\s+|\s+$//g; # strip leading/trailing whitespace if( /^%[lL]\s*<<<\s+(.*)\s+>>>/){ $title=$1; last find_title; } elsif (/^%[lL]$/) { next; } elsif (!$title && /^%[lL]\s*(.*)/) { $title=$1; } } seek(IN,0,SEEK_SET); if ($title eq '') { $title = "No Title";} ($fp_junk,$fp_junk,$fp_junk,$fp_junk,$fp_uid,$fp_junk,$fp_junk, $fp_junk,$fp_junk,$fp_junk, $fp_mtime) = stat(IN); ($fp_name,$fp_junk,$fp_junk,$fp_junk,$fp_junk, $fp_junk,$fp_gcos)=getpwuid($fp_uid); $fp_gcos =~ s/,+$//g; # strip following ',' ($fp_sec,$fp_min,$fp_hour,$fp_mday,$fp_mon,$fp_year) = localtime($fp_mtime); $head_comments = sprintf("\n", $fp_year,$fp_mon+1,$fp_mday,$fp_hour,$fp_min,$fp_sec); $head_comments .= "\n"; print &html_head($title,$head_comments); $literal_out=0; $menu_on=0; $suppress_blanklines=1; $eline = undef; $pline = undef; $type = undef; while(){ s/^#>p\s*[^;]*;\s*/%p /; # change extended cmd to regular next if /^(\#|\s*$)/; # Don't copy comments or blank lines s/^\s+|\s+$//g; # strip leading/trailing whitespace */ #print STDERR "\nLINE: $_\nTYPE: $type\nELINE: $eline\nPLINE: $pline\n"; # get rid of extra blank lines when changing modes if( /^%[lL]$/ && $suppress_blanklines ){ next; } $suppress_blanklines = 0; # left justify text, or center text. if( /^%[lL]/ ){ # Flush any pending menu set up &pendingexec; if($menu_on) { print ''; $menu_on=0; $suppress_blanklines=1; } if(!$literal_out) { print '
    ';
		    $literal_out=1;
		    $suppress_blanklines=1;
		}
		# get rid of prefix and one optional blank/tab.
		if( /^%([lL])\s?(.*)$/ && $1 eq 'l' ){
			$_ = $2;
			s/\&/\&\;/g;
			s/\';
	    $literal_out=0;
	}
	if($menu_on) {
	    print '';
	    $menu_on=0;
	}
	close(IN);
    } else {
      &main'error('not_found', "document \`\`$file\'\' does not exist");
    } 
    print &html_foot;
}

sub pendingexec {
#    print STDERR "DEBUG pending '$type' '$eline' '$pline'\n";
    $pline = 'Unknown'
    	if ! defined($pline);
    if ( defined($eline) ) {
	$eline =~ s/\&/\&\;/g;
	$eline =~ s/\';
	    $menu_on=0;
	    $suppress_blanklines=1;
	}
	if(!$literal_out) {
	    print '
    ';
	    $literal_out=1;
	    $suppress_blanklines=1;
	}
	print "     - $eline\n";
    } elsif ( ( $type eq 'BBGUEST' || $type eq 'WWWURL' ) && $eline && $pline ) {
	if($literal_out) {
	    print '
    ';
	    $literal_out=0;
	    $suppress_blanklines=1;
	}
	if(!$menu_on) {
	    print '';
	    $menu_on=1;
	    $suppress_blanklines=1;
	}
	if( $type eq 'WWWURL' ) {
	    print "
  •  $eline\n";
	} elsif( $pline =~ /^p\s/ ) {			# plain file
	    &more($eline,$pline);
	} elsif( $pline =~ /^nr\s/ ) {			# newsgroup
	    &newsreader($eline,$pline);
	} elsif( $pline =~ /^\$/ ) {			# sub menu
	    $pline =~ s/\$//;
	    print "
  •  $eline\n";
	} elsif( $pline =~ /^b?btelnet\s/ ) {		# telnet access
	    &bbtelnet($eline,$pline);
	} elsif( $pline =~ /^s?gopher\s/ ) {		# gopher access
	    &gopher($eline,$pline);
	} elsif( $pline =~ s/^\S*lynx\s+// ) {		# lynx access
	    print "
  •  $eline\n";
	} else {
	    print "
  •  Can't convert: $eline\n";
        }
    }
    $type  = undef;
    $eline = undef;
    $pline = undef;
}

1;