/#!/usr/local/bin/perl
#
# Copyright (C) 1992 by Gustaf Neumann, Stefan Nusser
#
#      Wirtschaftsuniversitaet Wien,
#      Abteilung fuer Wirtschaftsinformatik
#      Augasse 2-6,
#      A-1090 Vienna, Austria
#      neumann@wu-wien.ac.at, nusser@wu-wien.ac.at
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appears in all copies and that both that
# copyright notice and this permission notice appear in all supporting
# documentation.  This software is provided "as is" without expressed or
# implied warranty.
#
# Date: Mon, Apr 13 1992
# Author: Gustaf Neumann
# Version: 0.9
#

@ftpServers = (
		  'ftp.wu-wien.ac.at',
		  'wuarchive.wustl.edu', 
		  'ftp.uu.net',
		  'gatekeeper.dec.com',
		  'prep.ai.mit.edu',
		  'export.lcs.mit.edu',
);

$WafeLib = $ENV{'WAFELIB'} || "/usr/lib/X11/wafe";
require "$WafeLib/perl/wafe.pl";
require 'chat2.pl';
require 'ftp.pl';

$incoming = "$ENV{'HOME'}/incoming";
$CurrentSortMode = 'default';
$CurrentOrderMode = 'ascending';
$CurrentFTPMode = 'as Guessed';
$user = $ENV{'USER'} || 
     chop($user = `/usr/bin/whoami`) && $user;

$tmpfile = &wafe'tmpFile("ftp");

$cr = '\r?\n';
@FileTypes = (
	'^.*(\.Z|-z|\.arc|\.zip|\.zoo|\.lzh|\.tar|\.F|\.hqx)$', "compressed",
	'^.*(\.gif|\.jpg)$', "graphic",
	'^.*(\.exe|\.com|core|a\.out|\.o)$', "exec",
	'.*', "text",
);

$DATE = '/bin/date';

$LastFtpMode = "";
$server="";

#
# various  utilities 
#
sub bynumkey { $keys[$a] <=> $keys[$b]; }
sub byanumkey { $keys[$a] cmp $keys[$b]; }

# date and time conversion 
@MonthCorr = ( 0, 0, 3, 3, 4, 4, 5, 5, 5, 6, 6, 7 );
%Months = ('Jan',0, 'Feb',1, 'Mar',2, 'Apr',3, 'May',4, 'Jun',5, 'Jul',6, 
                    'Aug',7, 'Sep',8, 'Oct',9, 'Nov',10, 'Dec',11);

sub days_since_70 {
    local($d,$m,$y,$hour,$min) = @_;
    return (($y-1970)*365 + int(($y-1972)/4) + $m*31 +$d - 1 - $MonthCorr[$m])
	+$hour/24+$min/(60*24);
}

($ThisMonth,$ThisDay,$ThisYear) = (split(" ",`$DATE +'%m %d %y'`));
$ThisYear += ($ThisYear>91 ? 1900 : 2000);
$Now = &days_since_70($ThisDay,$ThisMonth,$ThisYear,0,0);

$top = "top chainTop bottom chainTop";
$bot = "top chainBottom bottom chainBottom";
$left = "left chainLeft right chainLeft";
$topfield = "$backGround borderWidth 0";
$brightBackGround = "background $1" if $roColors =~ /background\s+(\S+)/;
$threeDV = "vertDistance 6" if $threeD;

&UI( <<"End of Wafe");
if {\$XVERSION<"R5"} \\
     {puts stderr "To exploit the full functionality of this program,\\n\\
                wafe needs to be compiled with R5 libraries!"}

proc simpleButton {name father res} {\\
    eval command \$name \$father $buttonAtts "\$res callback {echo %w}"}

proc simpleMenue {name father label default vert horiz hlabel} { \\
    eval menuButton \$name \$father label \$label $top $right $topfield \\
       fromVert \$vert \$horiz menuName \${name}modes $boldFont $threeDNarrow; \\
    label \${name}mode \$father label \$default width 115 $top $right $topfield  \\
       justify left fromVert \$vert fromHoriz \$hlabel $normalFont $twoD; \\
    simpleMenu \${name}modes \$name $menueAtts}


form form topLevel width 620 $backGround

    label info form label {} width 620 $top $normalFont $infoColors

    menuButton serverLabel form label {FTP-Server:} $top $right $topfield \\
        menuName servers fromVert info $boldFont $threeD
    asciiText server form  editType edit width 300 $topfield $top $left \\
                fromHoriz serverLabel fromVert info $threeDV $normalFont
    action server override "<Key>Return : exec(sendvalue server server)"
    action server override "<Enter> : exec(sV server $highLight)"
    action server override "<Leave> : exec(sV server $backGround)"
    simpleMenu servers serverLabel $menueAtts

    label dir form label {Directory:} $top $left $topfield $boldFont \\
               fromVert serverLabel $threeDNarrow
    asciiText dirText form editType edit width 300 $topfield $top $left \\
               fromHoriz serverLabel fromVert serverLabel $threeDV \\
               sensitive false displayCaret false $normalFont
    action dirText override "<Key>Return : exec(sendvalue dirText dir)"
    action dirText override "<Enter> : exec(sV dirText $highLight)"
    action dirText override "<Leave> : exec(sV dirText $backGround)"

   simpleButton up form {fromVert serverLabel fromHoriz dirText $top sensitive false}


   simpleMenue FTP form {FTP-Mode:} {$CurrentFTPMode} dir {} FTP
   simpleMenue sort form {Sort-Mode:} {$CurrentSortMode} dir {fromHoriz FTPmode} sort
   simpleMenue order form {Order:} {$CurrentOrderMode} dir {fromHoriz sortmode} order

   viewport vp form allowVert true height 200 forceBars true fromVert sort \\
         top chainTop bottom chainBottom 
      sV vp.vertical $sbColors 
      box sb vp height 200  vSpace 0 width 620 height 200 $brightBackGround

    simpleButton quit form {fromVert vp $bot}
    simpleButton ftp form {fromVert vp fromHoriz quit sensitive false $bot}



    transientShell READMEshell form
    callback READMEshell popupCallback position form

       form READMEform READMEshell $backGround
          asciiText README READMEform width 590 height 300 \\
               type file string /dev/null \\
               scrollVertical always $textFont $roColors
          command cancel READMEform $buttonAtts callback {popdown READMEshell} \\
	       fromVert README 



proc sendvalue {w text} { \\
    echo \$text [gV \$w string] \\
}

proc labelLine {i line} { \\
     command l\$i sb unmanaged label \$line borderWidth 0 width 605 \\
	 justify left $roColors callback "echo read \$i"; \\
     action l\$i override "<Btn3Up>: exec(echo up)"; \\
     action l\$i override "<Key>Return : exec(echo read \$i)"; \\
     action l\$i override "<Key>Down : exec(sL +)"; \\
     action l\$i override "<Key>Up : exec(sL -)"; \\
     action l\$i override "<Key>Next : exec(sP +)"; \\
     action l\$i override "<Key>Prior : exec(sP -)"; \\
     }

proc sL {pm} { \\
     set rel [expr 0\$pm[gV l1 height].0/[gV sb height]]; \\
     set pos [expr [gV vertical topOfThumb]+\$rel]; \\
     scrollbarSetThumb vertical \$pos -1.0; \\
     callCallbacks vertical jumpProc float \$pos; \\
     }

proc sP {pm} { \\
     set lHeight [gV l1 height]; \\
     set rel [expr 0\$pm\$lHeight.0/[gV sb height]]; \\
     set lines [expr [gV  vp height]/\$lHeight]; \\
     set pos [expr [gV vertical topOfThumb]+\$rel*\$lines]; \\
     scrollbarSetThumb vertical \$pos -1.0; \\
     callCallbacks vertical jumpProc float \$pos; \\
     }

End of Wafe

&wafe'applyActions("README",@textActions);



sub refreshDir {
    &Xui(
        "sV ftp sensitive false\n"
	."sV dirText string {$_[0]} editType edit\n"
        . "callActionProc dirText {} end-of-line"
        );
}

sub fatal {
    local($text) = @_;

    &info("$text, aborting");
    undef @Labels;
    &newLabelBox($CurrentSortMode,$CurrentOrderMode);
    $server = "";
    &editDirField("false");
    &Xui("sV up sensitive false");
    $CurrentDir = "";
    &refreshDir($CurrentDir);
}


################################################### modified from ftp.pl
# Get a remote file back into a local file.
# If no loc_fname passed then uses rem_fname.
# returns 1 on success and 0 on failure
sub ftpget
{
	local($rem_fname, $loc_fname, $restart ) = @_;
	
	if ($loc_fname eq "") {
		$loc_fname = $rem_fname;
	}
	
	if( ! &ftp'open_data_socket() ){
		$reason =  "Cannot open data socket";
		return 0;
	}

	# Find the size of the target file
	local( $restart_at ) = &ftp'filesize( $loc_fname );
	if( $restart && $restart_at > 0 && &ftp'restart( $restart_at ) ){
		$restart = 1;
		# Make sure the file can be updated
		chmod( 0644, $loc_fname );
	}
	else {
		$restart = 0;
		unlink( $loc_fname );
	}

	&ftp'send( "RETR $rem_fname" );
	
	local( $ret ) =
		&ftp'expect($ftp'timeout, 
                   150, "receiving $loc_fname", 1,

                   125, "data connection already open?", 0,

                   450, "file unavailable", 2,
                   550, "file unavailable", 2,

		   500, "syntax error", 0,
		   501, "syntax error", 0,
		   530, "not logged in", 0,

		   421, "service unavailable, closing connection", 0);
	if( $ret != 1 ){
		$reason =  "Failure on RETR command";

		# shut down our end of the socket
		&ftp'close_data_socket;

		return 0;
	}

	# 
	# the data should be coming at us now
	#

	# now accept
	accept(ftp'NS,ftp'S) || ($reason = "accept failed", return 0);

	#
	#  open the local fname
	#  concatenate on the end if restarting, else just overwrite
	if( !open(FH, ($restart ? '>>' : '>') . $loc_fname) ){
		$reason = "Cannot create local file $loc_fname";

		# shut down our end of the socket
		&ftp'close_data_socket;

		return 0;
	}

	local( $start_time ) = time();
        local($interval,$tick,$lasttick,$elapsed) = (3,());
	local( $bytes, $lasthash, $hashes ) = (0, 0, 0);
	while( ($len = &ftp'read()) > 0 ){
		$bytes += $len;
		if( $strip_cr ){
			$ftp'buf =~ s/\r//g;
		}
		if( $ftp_show ){
			while( $bytes > ($lasthash + $ftp'hashevery) ){
				print '#';
				$lasthash += $ftp'hashevery;
				$hashes++;
				if( ($hashes % $ftp'hashnl) == 0 ){
					print "\n";
				}
			}
                }

                $elapsed = time() - $start_time;
                $tick = int($elapsed / $interval);

                if ($tick != $lasttick) {
		    &info("$bytes transferred in $elapsed seconds, "
                               .sprintf("%5.3f", $bytes/($elapsed*1000))." KB / sec") if $elapsed > 0;
                    $lasttick = $tick;
                }

 		print FH $ftp'buf;
	}
	close( FH );

	# shut down our end of the socket
	&ftp'close_data_socket;

	if( $len < 0 ){
		$reason = "timed out reading data!";

		return 0;
	}
		
	if( $ftp_show ){
		if( $hashes && ($hashes % $ftp'hashnl) != 0 ){
			print "\n";
		}
		local( $secs ) = (time - $start_time);
		if( $secs <= 0 ){
			$secs = 1; # To avoid a devide by zero;
		}

		local( $rate ) = int( $bytes / $secs );
		print "Got $bytes bytes ($rate bytes/sec)\n";
	}

	#
	# read the close
	#

	$ret = &ftp'expect($ftp'timeout, 
		226, "Got file", 1,     # transfer complete, closing connection
	        250, "Got file", 1,     # action completed
	
	        110, "restart not supported", 0,
	        425, "can't open data connection", 0,
	        426, "connection closed, transfer aborted", 0,
	        451, "action aborted, local error", 0,
		421, "service unavailable, closing connection", 0);

	return $ret;
}











sub connect {
    local($server) = $_[0];
    local($conn,$succ,$result);

    $conn = &chat'open_port($server, 21);
    if (!$conn) {
	&info("cannt open connection to $server");
        return "";
    }	

    &chat'expect($conn, 30,
		 "^2.*$cr", '($succ,$result)=(1,$conn);',
		 "^5.. .*$cr", '($succ,$result)=(0,"Server error: " . $&);',
		 "TIMEOUT", '($succ,$result)=(0,"Server connection timeout: $server\n");');
     return $conn if $succ;
     &info("Failed to connect: $result");
        return "";
}

sub login {
    local($conn) = @_;
    local($succ,$result);
    &chat'print($conn,"user anonymous\n");
    &chat'expect($conn, 30,
		 "^3.*$cr", '($succ,$result)=(1,$&);',
		 "^5.. .*$cr", '($succ,$result)=(0,"Server error: " . $&);',
		 "TIMEOUT", '($succ,$result)=(0,"Server connection timeout: $server\n");');

    if ($succ) {
#      print "login with passwd $user@$ENV{'HOST'}\n";
  	&chat'print($conn,"pass $user@$ENV{'HOST'}\n");
    	&chat'expect($conn, 30,
		 "^2.*$cr", '$succ=1;',
		 "^5.. .*$cr", '($succ,$result)=(0,"Server error: " . $&);',
		 "TIMEOUT", '($succ,$result)=(0,"Server connection timeout: $server\n");');
   }

    &info($result) if !$succ;   
}

sub dir {
    local($_,$typeflag,$size,$month,$day,$time,$name,$readflag);

    &ftpMode("ascii") || return 0;
    &info("reading directory $CurrentDir on $server");
    if ( !&ftp'dir_open() ) {
       &fatal("cannot read directory $CurrentDir on $server");
       return 0;
    }

    undef @Labels; undef @Type; undef @Name; undef @Selected; undef @order;
    while (<ftp'NS>) {
       chop; chop;
       if (m/^(\S)......(\S)\S+\s+\d+\s+\S+\s+\S+\s+(\d+)\s+(\S+)\s+(\d+)\s+(\S+)\s+(.*)\s*$/o ||
            m/^(\S)......(\S)\S+\s+\d+\s+\S+\s+(\d+)\s+(\S+)\s+(\d+)\s+(\S+)\s+(.*)\s*$/o) {
	   ($typeflag,$readflag,$size,$month,$day,$time,$name) = ($1,$2,$3,$4,$5,$6,$7);

	   next if $readflag ne 'r';

          push(@Labels,sprintf("%8d %s %2d %-5s %s",$size,$month,$day,$time,$name));

	  TYPE: {
             $Type = "folder", last TYPE if $typeflag eq "d";
             $Type = "folder", $name=$1, last TYPE if $name =~ m/(.*) \-\>.*/;

             # we want to process an associative array in the order the elements are defined
             for ($_= $[;  $_<$#FileTypes;   $_ += 2) {
                if ($name =~ m/^$FileTypes[$_]$/) {  $Type = $FileTypes[$_+1];  last; }
             }
          } 
         
          push(@Type,$Type);
          push(@Name,$name);
       }
    }
    &info("directory $CurrentDir on $server contains ".($#Labels+1)." entries");
    &newLabelBox($CurrentSortMode,$CurrentOrderMode);
}


sub changeTo {
    local($dir) = @_;
    local($lastdir);

    if ($dir ne $CurrentDir) {
           $lastdir = $CurrentDir;

           if (!&ftp'cwd($dir)) {
              &info("cannot change to directory $dir");
           } else {
	       $CurrentDir = $dir;
               &dir();
           }
           &refreshDir($CurrentDir);
           &Xui("sV up sensitive true") if length($CurrentDir > 1);
    }
}


%FTPmode = (
	    "ascii", "A",
	    "binary", "I",
	    );

# set the FTP mode if necessary
sub ftpMode {
    local($mode) = @_;
    if ($mode ne $LastFtpMode) {
#	print "set mode to $mode\n";
	unless (&ftp'type($FTPmode{$mode})) {
           &info("cannot set transfer mode to $mode");
           return 0;
        }
        $LastFtpMode = $mode;
    }
    return 1;
}

sub ftp {
    local($source,$target,$mode) = @_;

    &ftpMode($mode) || return 0;
    &info("starting transfer of $source");
    $strip_cr = ($mode eq "ascii");
    if( ! &ftpget($source, "$target", 0 )) {
       &info("cannot ftp $source into $incoming, reason: $reason");
       return 0;
    } else { 
       &info("transfer of $source into $target done");
       return 1;
    }
}



sub setLabelAttributes {
    local($i) = @_;
    local($bitmap,$background);
    $bitmap = "$Type[$i].xbm";
    $background = $Selected[$i] ? "$highLight $highLightTextFont" : "$roColors $textFont"; 
    &Xui("sV l$i width 605 leftBitmap $WafeBitmaps/$bitmap $background");
}

sub setLabelActions {
    local($i) = @_;
    &Xui("action l$i override {<Btn2Down>: exec(echo readme $i)}") if $Type[$i] eq "text";
}


sub setListLabelsBox {
    local($low,$high,$up) = @_;
    local(@range);
    local( $toManage) =  "";

    @range = $up ? 
	 defined(@order) ? @order[$low .. $high] : ($low .. $high) :
	 defined(@order) ? reverse(@order[$low..$high]) : reverse($low .. $high);
    
#    print "range has $#range elements, $low, $high\n";

     for (@range) {
	if ($Created[$_] != 1) { 
 	    &Xui("labelLine $_ {$Labels[$_]}");
	    $Created[$_] = 1;
            $toManage .= "l$_ ";
	}
        
        &setLabelAttributes($_);
        &setLabelActions($_);
    }
    &Xui("manageChild $toManage") if $toManage;
}


sub reverseLookup {
    local($entry) = @_;
    if (defined(@order)) {
	local($_);
	for ($[ .. $#order) {
	    if ($entry == $order[$_]) { $entry = $_;  last; }
	}
    }
    return $entry;
}






sub newLabelBox {
    local($SortMode,$OrderMode) = @_;
    local($k);

    &Xui("destroyWidget sb; box sb vp vSpace 0 width 620 height 200 $brightBackGround");
    undef @Created;  

    undef @order;
    if ($SortMode ne "default") {
	undef @keys;
	if ($SortMode eq "by Size") {
	    for (@Labels) { push(@keys,(split(" ",$_))[0]); } 
	    @order = sort bynumkey $[ .. $#Labels;
	}
	if ($SortMode eq "by Name") {
	    for (@Labels) { 
		($k = (split(" ",$_))[4]) =~ tr/a-z/A-Z/;
		push(@keys,$k);
	    }
	    @order = sort byanumkey $[ .. $#Labels;
	}
	if ($SortMode eq "by Age") {
	    local($day,$month,$year,$hour,$min);
	    for (@Labels) { 
		($month,$day,$year) = (split(" ",$_))[1,2,3];
		$month = $Months{$month};
                if ($year =~ /(\d+):(\d+)/) {
		    if (($k = &days_since_70($day,$month,$ThisYear,$1,$2))-$Now > 1) {
#			print "k = $k, now = $Now, must have been last year\n";
			$k = &days_since_70($day,$month,$ThisYear-1,$1,$2);
		    }
		}  else { 
		    $k = &days_since_70($day,$month,$year,0,0);
		}
		push(@keys,-$k);
	    }
	    @order = sort bynumkey $[ .. $#Labels;
	}
    }
    $CurrentSortMode = $SortMode;
    $CurrentOrderMode = $OrderMode;
    &setListLabelsBox($[,$#Labels,($CurrentOrderMode eq 'ascending'));
}


sub editDirField {
    &Xui("sV dirText sensitive $_[0] displayCaret $_[0]"); 
}

&Xui('realize');
&info('no ftp-server selected');

&simpleMenue("servers","server","string",@ftpServers); 
&simpleMenue("sortmodes","sortmode","label",("default","by Size","by Name","by Age")); 
&simpleMenue("FTPmodes","FTPmode","label",("as Guessed","ascii","binary")); 
&simpleMenue("ordermodes","ordermode","label",("ascending","descending")); 


while (<STDIN>) {

    if (/^server\s+(\S+)/) {
        next if $1 eq $server;   # we are already connected
        &ftp'quit if $server ne "";

        $server = $1;
	&info("trying to connect to $server ...");
        if ($conn = &connect($server)) {

           &info("connection to $server established");
           &login($conn);
           &info("login performed");
           &editDirField("true");
  	   &Xui("sV up sensitive false");
	   $CurrentDir = "/";
           &refreshDir($CurrentDir);
           &dir();
        } else {
           &fatal("cannot connect to $server");
        }
    }

    if (/^read (\d+)/) {
	$entry = $1;
	if ( $Type[$entry] eq "folder" ) {
	   $CurrentDir .= "$Name[$entry]/";
           &ftp'cwd($CurrentDir); 
           &refreshDir($CurrentDir);
           &Xui("sV up sensitive true");
           &dir();
        } else {
	    $Selected[$entry] = !$Selected[$entry];
	    $display = &reverseLookup($entry);
#	    print "selected = ",grep(($_==1),@Selected), "\n";
	    &Xui("sV ftp sensitive ". (grep(($_==1),@Selected)>0 ? "true" : "false"));
	    &setListLabelsBox($display,$display,($CurrentOrderMode eq 'ascending'));
        }
    }


    if (/^dir\s*(\S*)/) {
	$entry = $1;
        $entry .= "/" if substr($entry,length($entry)-1,1) ne "/";
        &changeTo($entry);
    }

    if (/^up/) {
        &changeTo(substr($CurrentDir,0,rindex($CurrentDir,'/',length($CurrentDir)-2))."/");;
    }


    if (/^sortmode\s+(.+)/) {
	&newLabelBox($1,$CurrentOrderMode) if $CurrentSortMode ne $1;
    }
    if (/^ordermode\s+(.+)/) {
	&newLabelBox($CurrentSortMode,$1) if $CurrentOrderMode ne $1;
    }
    if (/^FTPmode\s+(.+)/) {
	$CurrentFTPMode = $1;
#	print "CurrentFTPMode set to $1\n";
    }




   if (/^ftp/) {
       local($_,$mode,$display) = ();
       for ($[ .. $#Selected) {
	   if ($Selected[$_]) {
	       $mode = $CurrentFTPMode eq "as Guessed" ? 
		           ($Type[$_] eq "text" ? "ascii" : "binary") :
			   $CurrentFTPMode;

               # create the incoming directory if necessary
               unless((-d $incoming) || mkdir($incoming,0755)) {
                      &info("cannot create incoming directory $incoming");
                      last;
               }

               # transfer the file
               if (&ftp($Name[$_], "$incoming/$Name[$_]", $mode)) {
	           $Selected[$_] = ! $Selected[$_];
                   $display = &reverseLookup($_);
                   &setListLabelsBox($display,$display,($CurrentOrderMode eq 'ascending'));
               }         
	   }    
       }
       &Xui("sV ftp sensitive false");
   }


   if (/^readme\s+(.*)/) {
       if (&ftp($Name[$1], $tmpfile, "ascii")) {
	   &Xui("sV README string $tmpfile; popup READMEshell none") if -T $tmpfile;
	   &info("the file $Name[$1] cannot be viewed, does not appear to be a text file") 
	       if -B $tmpfile;
       }
   }
   

   if (/^quit/) {
#      print "doing a quit\n";
      &chat'print($conn,"quit\n");
      &wafe'cleanup();
   }

#   print "RECEIVED: $_";
}

