#!/bin/sh -- # A comment mentioning perl, indented bash's sake.
eval 'exec perl -S $0 ${1+"$@"}'
        if 0;
#
# Mirrors a set of local files (e.g. website pages & images) to an ftp server.
# Place the mirrored dirs and file globs in the %content below.
# N.B. each dir has an ftp MDELETE run on it. ALL remote files are destroyed.
# See Usage for more information.
# Copyright (c) 2001 by Karl J. Runge <runge@karlrunge.com>
#

#---------------- copy this sort of stuff for a -f file --------------------#
$host	= 'ftp.somesite.net';		# ftp server
$user	= 'runge';			# username on server
$pass	= 'xxxxxxx';			# set to nothing for prompt,
					# or set to NONE for no passwd
$makedirs = 0;				# create the directories on server
$passive = 1;				# use passive ftp not
$topdir	= 'public_html/mysite/test';	# toplevel remote dir to cd to.

# for each dir make a hash entry containing the glob or list of files to upload:
$content{'.'}		= '*.html *.css';
$content{'images'}	= '*.jpg *.gif';
#---------------------------------------------------------------------------#

#############################################################################
# No real need to change anything below. Some could be put into -f file ...
#############################################################################

chomp($Program = `basename $0`);

$FP = "ftp> ";		# the ftp(1) cmd prompt.
$Mode = 'echo,die';	# waitfor() parameters.
$Timeout = 30;		# waitfor() timeout.

$Debug = 0;
$Delete = 1;
$Source_File = '';
$Remove_Dirs = 0;
$Do_Shell = 0;

$Usage = <<"END";

$Program: 

 Mirrors a set of local files (e.g. website pages & images) to an ftp server.
 Place the mirrored dirs and file globs in the \%content in script (or use -f).
 N.B. each dir has an ftp MDELETE run on it. ALL remote files are destroyed.
 Copyright (c) 2001 by Karl J. Runge <runge\@karlrunge.com>


Usage: $Program <options> <items>

Options:
	-h <host>	set ftp server host ($host)
	-u <user>	set ftp server user name ($user)
	-p <pass>	set ftp server password

	-d <dir>	set toplevel ftp server directory
			($topdir)

	-c <dir:file>	create and/or add to the content hash.
			<file> could be a glob pattern.
			Overrides content in -f file or script defaults.
			Overridden by command line items.

	-k		mkdir the directories (e.g. the initial upload)
			(will create all components of toplevel dir if missing)
	-R		remove all the files and directories
			(but does not remove top level dir)

	-t <time>	set waitfor() timeout in seconds ($Timeout sec)
	-n 		do not do MDELETE on remote dirs.
	-P		do not use passive ftp mode.
	-x		yield an interactive ftp shell after logging in.

	-f <file>	source config file <file> to set variables.

	-D 		turn on much debugging output for waitfors and etc.

	<items>		specific items to upload, overrides \%content
			and implies -n

Here is example setting of the \%content hash (set in this script or -f file)

\$content{'.'}		= '*.html *.css';
\$content{'images'}	= '*.jpg *.gif';
\$content{'doc'}		= '*.pdf *.ps';
\$content{'doc/txt'}	= '*.txt';

that is to say, all html and css files in the current dir get uploaded
to toplevel_dir on the remote machine and then all jpg and gif files in
images get uploaded to toplevel_dir/images. Etc.

An <item> might look like images/picture1.gif, etc.

Notes:
	If password is empty then it will be prompted for w/o echoing.
	If it is 'NONE' no password is used.
	If it is 'STDIN' password is read from next line of STDIN.

	Uses twice the timeout when uploading files (2 * $Timeout sec).

	Make the -f file look like the top portion of this script,
	then set your defaults. It will be sourced as perl commands.

	The mkdirs, mdeletes, and rmdirs are assumed to succeed with
	no checking. 

	It is of course better to use scp(1) or rsync(1)+ssh(1) to
	avoid passwords being sniffed. But some webpage providers
	only provide ftp(1) access. scp(1) and rcp(1) have recursive
	copying features as well.

	This program depends extensively on the input and output of
	the BSD ftp(1) command. It likely will not work with other ftp
	clients, unless they are highly compatible.
END

LOOP:	
while (@ARGV) {
    $_ = shift;
    CASE: {
	/^-h$/ && ($host = shift, last CASE);
	/^-u$/ && ($user = shift, last CASE);
	/^-p$/ && ($pass = shift, last CASE);
	/^-t$/ && ($Timeout = shift, last CASE);
	/^-f$/ && ($Source_File = shift, last CASE);
	/^-d$/ && ($topdir = shift, last CASE);
	/^-P$/ && ($passive = 0, last CASE);
	/^-n$/ && ($Delete = 0, last CASE);
	/^-k$/ && ($makedirs = 1, last CASE);
	/^-c$/ && (push(@content_in, shift(@ARGV)), last CASE);
	/^-x$/ && ($Do_Shell = 1, last CASE);
	/^-R$/ && ($Remove_Dirs = 1, last CASE);
	/^-D$/ && ($Debug = 1, last CASE);
	/^--$/ && (last LOOP);	# -- means end of switches
	/^-(-.*)$/ && (unshift(@ARGV, $1), last CASE);
	/^(-help)$/ && ((print STDERR $Usage), exit 0, last CASE);
	if ( /^-(..+)$/ ) {	# split bundled switches:
		local($y, $x) = ($1, '');
		foreach $x (reverse(split(//, $y))) { unshift(@ARGV,"-$x") };
		last CASE;
	}
	/^-/ && ((print STDERR "Invalid arg: $_\n$Usage"), exit 1, last CASE);
	unshift(@ARGV,$_);
	last LOOP;
    }
}

if ( $Source_File ne '' ) {
	undef %content;		# assume they will certainly set it in the file.
	require $Source_File;
}

if ( @content_in ) {
	undef %content;
	foreach my $item (@content_in) {
		my ($dir, $glob) = split(/:/, $item, 2);
		if ( $content{$dir} ne '' ) {
			$content{$dir} .= " $glob";
		} else {
			$content{$dir} = $glob;
		}
	}
}

if ( $host eq '' || $user eq '' ) {
	print STDERR $Usage;
	exit 1;
}

$Specific_Items = 0;
if ( @ARGV ) {
	# the listed content on cmd line:
	$Delete = 0;
	undef %content;
	foreach $item (@ARGV) {
		my ($dir, $base);
		chomp($dir  = `dirname  '$item'`);
		chomp($base = `basename '$item'`);
		if ( $content{$dir} ne '' ) {
			$content{$dir} .= " $base";
		} else {
			$content{$dir} = $base;
		}
	}
	$Specific_Items = 1;
}

select(STDERR); $| = 1;
select(STDOUT); $| = 1;

#
# method to open subprocess ftp(1):
#
$Open_Mode = 'open2';	# busted, do not use it.
$Open_Mode = 'pty';	# opens a pseudo terminal.

sub wait4 {
	# just an alias for full waitfor() call
	my ($x) = @_;
	return &waitfor($x, $FTP_FROM, $Timeout, $Mode);
}


#######################################################
# spawn ftp(1) process, establish connection, xfer, etc. 

&open_ftp($host) || die "$!";

&print2("user $user\n");

if ( $pass ne 'NONE' ) {
	# password processing
	&wait4('Password: ');

	if ( $pass eq 'STDIN' ) {
		print STDERR "reading password from STDIN ...\n";
		chomp($pass = <STDIN>);
		if ( $Do_Shell ) {
			close(STDIN);
			open(STDIN, "</dev/tty");
		}
	} elsif ( $pass eq '' ) {
		print STDERR "\n$Program: enter password for $user\@$host: ";
		system("stty -echo");
		chop($pass = <STDIN>);
		print STDERR "\n";
		system("stty echo");
	}
	&print2("$pass\n");
	&wait4('230 ');
}
&wait4($FP);

if ( $passive ) {
	# usually need passive for firewalls
	&print2("passive\n");
	&wait4('Passive mode on');
	&wait4($FP);
}

&print2("binary\n");
&wait4($FP);

&print2("prompt off\n");	# for mdelete, mput, etc
&wait4($FP);

if ( $makedirs ) {
	my (%mkdirs, %madedir);
	if ( $topdir ne '' ) {
		$mkdirs{$topdir} = 1;
	}
	foreach $dir (keys(%content)) {
		next if $dir eq '.';
		if ( $topdir ne '' ) {
			$mkdirs{"$topdir/$dir"} = 1;
		} else {
			$mkdirs{"$dir"} = 1;
		}
	}
	foreach my $try (keys(%mkdirs)) {
		my $path = '';
		foreach my $part (split(/\//, $try)) {
			if ( $path eq '' ) {
				$path = $part;
			} else {
				$path .= "/$part"; 
			}
			next if $madedir{$path};
			# print "mkdir $path\n";
			&print2("mkdir $path\n");
			# assume it works when applicable...
			&wait4($FP);
			$madedir{$path} = 1;
		}
	}
}

if ( $Remove_Dirs ) {
	my (%rmdirs, %removeddir, %cleaneddir);
	foreach $dir (keys(%content)) {
		if ( $topdir ne '' ) {
			if ( $dir eq '.' ) {
				$rmdirs{"$topdir"} = 1;
			} else {
				$rmdirs{"$topdir/$dir"} = 1;
			}
		} else {
			if ( $dir eq '.' ) {
				$rmdirs{"."} = 1;
			} else {
				$rmdirs{"$dir"} = 1;
			}
		}
	}
	my $topmatch = $topdir; 
	if ( $topmatch ne '' ) {
		$topmatch =~ s/(\W)/\\$1/g;
	}

	# first clean out all the files:
	foreach my $try (keys(%rmdirs)) {
		my $path = '';
		foreach my $part (split(/\//, $try)) {
			if ( $path eq '' ) {
				$path = $part;
			} else {
				$path .= "/$part"; 
			}
			if ( $topmatch ne '' ) {
				# only clean from topdir down:
				next unless $path =~ m,^$topmatch,;
			}
			next if $cleaneddir{$path};
			# print "mdelete $path\n";
			&print2("mdelete $path\n");
			# assume it works when applicable...
			&wait4($FP);
			$cleaneddir{$path} = 1;
		}
	}

	if ( $topdir ne '' ) {
		$removeddir{$topdir} = 1;	# trick to not rmdir the topdir
	}
	# now delete the presumably empty dirs:
	foreach my $path (sort {length($b) <=> length($a)} keys(%cleaneddir) ) {
		next if $removeddir{$path};
		# print "rmdir $path\n";
		&print2("rmdir $path\n");
		# assume it works when applicable...
		&wait4($FP);
		$removeddir{$path} = 1;
	}

	# finish:
	&print2("quit\n");
	&wait4('bye');
	print STDERR "\n";
	wait;

	exit 0;
}

if ( $topdir ne '' ) {
	&print2("cd $topdir\n");
	&wait4('250 ');
	&wait4($FP);
}

if ( $Do_Shell ) {
	print STDERR "\n\n*** here is your ftp shell ***\n\n$FP";

	# getc() is good enough for most cases, though some sort of
	# dup would be best
	my $dofork = 1;

	if ( $dofork ) {
		if ( $pid = fork ) {
			while (! eof($FTP_FROM) ) {
				$c = getc($FTP_FROM);
				print STDOUT $c;
			}
			close($FTP_FROM);
			kill TERM, $pid;
			kill INT,  $pid;
			
		} else {
			while (! eof(STDIN) ) {
				$c = getc(STDIN);
				print $FTP_TO $c;
			}
			close($FTP_TO);
		}
	} else {
		;	# ???
	}
	exit 0;
}

if ( $Delete ) {
	foreach $dir (keys(%content)) {
		# clean out destination dirs:
		&print2("mdelete $dir\n");
		&wait4($FP);
	}
}

foreach $dir (keys(%content)) {

	# find the directory changes required:
	if ( $dir eq '.' ) {
		$cd_to   = '';
		$cd_back = '';
	} else {
		$cd_to   = $dir;
		$cd_back = $cd_to;
		$cd_back =~ s,[^/]+,..,g;
	}

	if ( $cd_to ne '' ) {
		if ( ! -d $cd_to ) {
			die "no local dir: $cd_to: $!\n";
		}

		# do the local and remote change dirs:
		&print2("lcd $dir\n");
		&wait4('Local directory now');
		&wait4($FP);

		&print2("cd $cd_to\n");
		&wait4('250 ');
		&wait4($FP);
	}

	# double the timeout for file xfer...
	my $t_old = $Timeout;
	$Timeout *= 2;	# or set to large value, e.g. 300

	# put all the files there:
	&print2("mput $content{$dir}\n");
	&wait4('226 ');
	&wait4($FP);

	$Timeout = $t_old;

	# list them:
	&print2("pwd\n");
	&wait4($FP);
	if ( $Specific_Items ) {
		foreach $item (split(/\s+/, $content{$dir})) {
			&print2("ls $item\n");
			&wait4('226 ');
			&wait4($FP);
		}
	} else {
		&print2("ls\n");
		&wait4('226 ');
		&wait4($FP);
	}

	if ( $cd_back ne '' ) {
		# now go back up to starting dir:

		&print2("lcd $cd_back\n");
		&wait4('Local directory now');
		&wait4($FP);

		&print2("cd $cd_back\n");
		&wait4('250 ');
		&wait4($FP);
	}
}

# finish:
&print2("quit\n");
&wait4('bye');
print STDERR "\n";
wait;

exit 0;

#####################################################################
# subroutines:

sub print2 {
	my($msg) = @_;
	if ( $Debug ) {
		print STDERR "\n>>> print2\($msg\) >>>\n"
	}
	print $FTP_TO $msg;
}

sub open_ftp {
	my($host) = @_;

	my($str);
	my $ftp_cmd = 'ftp -n';

	print STDERR "open'ing($Open_Mode): $ftp_cmd $host\n";

	if ( $Open_Mode eq 'pty' ) {
		$PTY = 'PTY';
		$FTP_TO   = $PTY;
		$FTP_FROM = $PTY;

		$Ftp_Pid = &ptyexec($PTY, "$ftp_cmd $host");
	} elsif ( $Open_Mode eq 'open2' ) {

		require 'open2.pl';

		$Ftp_Pid = &open2(FROM, TO, "$ftp_cmd $host 2>&1");
		$FTP_TO   = TO;
		$FTP_FROM = FROM;
	}
	die "$!" if !defined($Ftp_Pid);

	if ( $FTP_TO ne '' ) {
		my $old = select($FTP_TO); $| = 1;
		select($old);
	}

	$str = &waitfor('220 ',	$FTP_FROM, $Timeout, "$Mode,close_on_timeout"); 
	if ( $Timeout && $GLOBAL_waitfor_timedout ) {
		kill 9, $Ftp_Pid if $Ftp_Pid;
		wait;
		return;
	}
	if ( $str =~ /Host name lookup failure/i ) {
		kill 9, $Ftp_Pid if $Ftp_Pid;
		wait;
		return;
	}

	&waitfor($FP,		$FTP_FROM, $Timeout, "$Mode,close_on_timeout"); 
	if ( $Timeout && $GLOBAL_waitfor_timedout ) {
		kill 9, $Ftp_Pid if $Ftp_Pid;
		wait;
		return;
	}

	return 1;
}

#
# wait for the occurence of a string in a filehandles output
#
sub waitfor {
	my($pattern, $handle, $timeout, $mode) = @_;

	# modes: echo die debug close_on_timeout

	my($c, $str, $flags, $echo);

	$c = '';

	# see if pattern is a regex
	if ( $pattern =~ m,^/(.*)/([^/]+)$, ) {
		$pattern = $1;
		$flags = $2;
	}

	$mode .= ',debug' if $Debug;

	# old and slow way, eval a sub:
	eval "sub waitfor_matchit { 
		my(\$x) = \@_; 
		if ( \$x =~ /$pattern/$flags ) {
			return 1;
		}
		return 0;
	}";

	$timeout = 30 if !defined($timeout) || $timeout eq '';
	$echo = 1 if $mode =~ /echo/i;

	print STDERR "\n### waitfor(/$pattern/, $handle, $timeout, $mode) ###\n" if $mode =~ /debug/i;

	# set these in globals because if we got a signal best just
	# to read them rather than calling subs, etc.
	$GLOBAL_waitfor_got_alarm = 0;
	$GLOBAL_waitfor_timedout  = 0;
	$GLOBAL_waitfor_die = 0;
	$GLOBAL_waitfor_handle    = '';

	$GLOBAL_waitfor_die = 1 if $mode =~ /die/;

	if ( $timeout > 0 ) {
		$SIG{'ALRM'} = 'alarm_handler';
		$GLOBAL_waitfor_handle = $handle if $mode =~ /close_on_timeout/;
		sub alarm_handler {
			print STDERR "\n$Program: TIMED OUT.\n";
			$GLOBAL_waitfor_got_alarm = 1;
			$GLOBAL_waitfor_timedout = 1;
			if ( $GLOBAL_waitfor_handle ) {
				close $GLOBAL_waitfor_handle;
			}
			alarm(0);
			exit 1 if $GLOBAL_waitfor_die;
			return;
		}
		alarm($timeout);
	}

	$str = '';
	while (1) {
		$c = getc($handle);
		if ( $timeout > 0 && $GLOBAL_waitfor_got_alarm ) {
			$c = '';
			print STDERR $str if $echo;
			if ( $Mode =~ /die/i ) {
				die;
			} else {
				return;
			}
		}
		$str .= $c;
		print STDERR $c if $mode =~ /debug/;
		last if &waitfor_matchit($str);
	}
	print STDERR "\n" if $mode =~ /debug/;
	print STDERR $str if $echo;
	alarm(0) if $timeout > 0;

	print STDERR "\n<<< waitfor *FOUND* \"$str\" <<<\n" if  $mode =~ /debug/i;

	return $str;
}

#
# run a command and connect it to a pseudo terminal.
#
sub ptyexec {
	my($fh, $cmd) = @_;
	my($pid);

	my($master, $slave) = &openpty($fh);
	return undef if !defined($master);

	$pid = fork;
	die "ptyexec: fork failed: $!" unless defined($pid);

	if ( ! $pid ) {
		close $fh;
		(syscall(&SYS_setsid)>0) || die "setsid: $!";
		open(STDIN, "+>$slave")  || die "open slave: $!";
		open(STDOUT, ">&STDIN");
		open(STDERR, ">&STDIN");
		exec split(/\s+/, $cmd);
		die "ptyexec: exec failed: $cmd: $!";
	} else {
		return $pid;
	}
}

#
# open a master/slave pseudo terminal pair (old-fashioned way):
# 
sub openpty {
	my($fh) = @_;
	my($maj, $min, $dev, $master, $slave);

	if ( ! $GLOBAL_openpty_require_sys_syscall ) {
		require "sys/syscall.ph";
		$GLOBAL_openpty_require_sys_syscall = 1;
	}
	foreach $maj ("p".."s") {
		foreach $min ("0".."9", "a".."f") {
			$dev = "$maj$min";
			$master = sprintf("/dev/pty%s", $dev);
			$slave  = sprintf("/dev/tty%s", $dev);
			if (open($fh, "+>$master")) {
				return ($master, $slave, $fh);
			}
		}
	}
	return (undef, undef, undef);
}

#
# sleep a floating point amount of time.
#
sub fsleep {
	my ($time) = @_;
	select(undef, undef, undef, $time) if $time;
}