#!/usr/local/bin/perl
#
# ssm
#
$version = 'ssm-1.0.6 1-16-98';
$author  = 'Michael Robinton <michael\@bzs.org>';
#
# Routines to mirror this site to a remote site using ssh
#
  ############ WARNING -- WARNING -- WARNING ###########
  #                                                    #
  # DO not use links ABOVE the source directory, this  #
  #  routine WILL attempt to link them on the TARGET   #
  #                                                    #
  ######################################################
#
#
##################### CHANGES #########################
# V1.0.6	correct type in error message
#
# V1.0.5	incorporate test of source to exclude
#		links; symptom - erases target
#
#######################################################
# Operation:
#
# 'ssm' calls 'putf' (recursive if '-r' present)
# that puts local current files on the remote site, deleting the 
# files on the remote site that are no longer present on the local
# site. Backups, fifos, and sockets are ignored
#  ( ~, !, = ), except that backups on the remote are deleted.
# Files present on the target that are not on the source are deleted.
# Directories are ignored if recursion is off.
#
################################################################
# Revision History
#
################################################################
#	SOME OF THESE MAY NEED TO BE CHANGED FOR YOUR SYSTEM
################################################################
$List  = '/bin/ls -lF'.$A;	# ls command, long format with classifications
$Link  = '/bin/ln -fs';		# ln forced, soft links
$Mkdir = '/bin/mkdir -p';	# mkdir force parents
$Remove = '/bin/rm -rf';	# remove recursive unconditionally
$SSDIR  = '/usr/local/bin';	# directory for ssh commands

#   file classificaton
#	~	backup		b
#	*	executable	e
#	/	directory	d
#	@	link		l
#	|	fifo		f
#	=	socket		s
#   <no suffix>	plain file	p

$c_bfs 		= '\~|\||\=';			# backup, fifo, socket
$c_any 		= '\~|\*|/|\@|\||\=';		# any b,e,d,l,f,s
$c_fs		= '\||\=';			# fifo, socket
$c_not_e	= '\~|/|\@|\||\=';		# all but 'e'

$lnkcnt = 0;			# link count
$xfrcnt = 0;			# transfer count
$delcnt = 0;			# delete (replace) count

local ( @pidlist );		# keep track of children

# defaults
#
#$Debug = 0;				# default 'undef'
$Transfer = 'ON';			# off, undef, no, 0 - turns off
#$Recurs = 				# default 'undef' otherwise 'ON'

################# END USER PARAMETERS #########################


if ( $ARGV[0] eq '' ) { 		# check for real dumb entry
  print STDERR "ssm: No command arguments, type 'ssm -h' for help\n";
  exit 1;
}

# load OPTIONS
#
# 
local ( $i );
while ( $ARGV[0] =~ /^-/ ) {		# while there are options
  undef @Option;			# clear option array
  @Option = split (' *', (shift @ARGV));	# get the option
  for ( $i=1; $i <= $#Option; $i++ ) {
    if ( $Option[$i] =~ /r/i ) {		# if recursion
      $Recurs = 'ON';			# define recursion
      next;
    } elsif ( $Option[$i] =~ /v/i ) {	# if version
      print "$version\n";
      exit 1;
    } elsif ( $Option[$i] =~ /A/ ) {	# if transfer '.' files
      $A = 'A';				# GOBAL 'A'
      next;
    } elsif ( $Option[$i] =~/C/ ) {	# if compression
      $C = '-C ';
      next;
    } elsif ( $Option[$i] =~ /w/ ) {	# if NO WAIT
      $NoWait = 1;
      next;
    } elsif ( $Option[$i] =~ /x/ ) {	# if transfer OFF
      $Transfer = 'OFF';
      next;
    } elsif ( $Option[$i] =~ /d/ ) {	# if debug
      if (( $i+1) ne $#Option ) {	# if debug syntax error
	print STDERR "\ssm: -d syntax error, type 'ssm -h' for help\n";
	exit 1;
      }
      ++$i;
      $Debug = $Option[$i];
      next;
    } # end if Option, unknown OPTION, enter HELP
    &Help;				# print help and exit
    exit 1;
  } # end for Options
}  # end while Options

&CheckSwitches;					# Set debugging flags

# check for illegal Source wild card expansion
$i=0;
while ( $#ARGV > 1 ) {
  $Source[$i] = shift @ARGV;	# collect source items
  ++$i;
} # end more arguments

if ( $#Source > 0 ) {
  print STDERR "ssm: Illegal wildcard characters, type 'ssm -h' for help\n";
  exit 1;
}  
$Source = $Source[0];
if ( $Source =~ m:/$: ) {
  chop $Source;				# strip trailing '/'
}
( $RmHost, $Target ) = @ARGV;		# get host and target
if ( $Target =~ m:/$: ) {
  chop $Target;				# strip trailing '/'
}
if (( $Target =~ /\@/ ) ||
    ( $RmHost !~ /\@/ ) ||
    ( $Source eq '' ) ||
    ( $RmHost eq '' ) ||
    ( $Target eq '' )) {
  print STDERR "ssm: Command line syntax error, type 'ssm -h' for help\n";
  exit 1;
}
if (( $RmHost =~ /\?|\*/ ) ||
    ( $Target =~ /\?|\*/ )) {
  print STDERR "ssm: Illegal wildcard characters, type 'ssm -h' for help\n";
  exit 1;
}
############ TEST for valid source and target files ########
#	set GLOBAL source type 'stype'
if ( -l $Source ) {			# check for source=link
  print STDERR "ssm: Illegal use of link in source, specify full path\n";
  exit 1;
}
unless ( $stype = ( -d $Source )) {	# continue if source is directory
  unless ( -f $Source ) {		# continue if source is reg file
    print STDERR "ssm: $Source: Not a regular file or directory\n";
    exit 1;
  } # end reg file
} # end unless directory
#### note that sense of test is reversed for target !!!
if ( system ("$SSDIR/ssh $C$RmHost test -d $Target")) { # continue if directory
  unless ( system ("$SSDIR/ssh $C$RmHost test -e $Target")) {	# punt if exists
    print STDERR "ssm: cannot create directory $Target: File exists\n";
    exit 1;
  } # end punt
#### target directory does not exit, create it.
  &Dprint (3,"Creating $RmHost:$Target\n");
  if ( $Transfer eq 'ON' ) {
    system ("$SSDIR/ssh $C$RmHost mkdir -p $Target");
  } # end xfr on
} # end unless target dir
# Move the file!

#########################
&Putf ( $Source, $Target );		# move the files
#########################

unless ( defined ( $NoWait )) {		# unless No Wait check children
  foreach $i ( @pidlist ) {		# check child processes generated
    if ( $i > 0 ) {			# if child still active
      open ( WAITING, ("ps h $i |"));
      $tmp = <WAITING>;
      close WAITING;
      &Dprint (4,"\nWaiting for:\n");
      waitpid ( $i, 0 );
    }
  }
}
			# print the results
&Dprint (1,"transfers $xfrcnt, deletes $delcnt, links $lnkcnt\n");
exit 0;				# return a good status
# END MAIN

############ Send each source list item #######################
# 'Putf'
# Subroutine to test and send each source item listsd,
# further explanation below
#
# Uses:		Source, RmHost, Target
#
sub Putf {			# process each source item
################### Main work routine ********************
# This portion of the
# Subroutine actually does the work of moving the files, links
# and directories from the target to the host. It 'put's
# files, links, and directories on the remote host
#
# Input: source, target			GLOBAL(RmHost, others...)
#
  local ( $source, $target ) = @_;
  local ( $i, $j, *tmp, $class, $file );
  local ( @ssize, @smo, @sday, @shr, @sname, @slink );
  local ( @tsize, @tmo, @tday, @thr, @tname, @tlink );
  local ( *SENDlist, *DELetlst, *UnMDelete );

####### get the directories for source and target
# The first record returned from the 'list' command
# and placed into the respective arrays
# contains the 'total files' in the directory.
# we do not use this, however, the position '0' in
# the array is used to indicate a failed match when
# doing 'source' 'target' searches.

  open ( LOCal, "$List $source |" );
  $i = 0;
  unless ( $stype ) {			# process normally if source = directory
    $tmp = "total 1\n";			# dummy total
    &Dprint (5,$tmp);
    ( $ssize[$i], $smo[$i], $sday[$i], $shr[$i], $sname[$i], $slink[$i] )=
	&SplitList ( $tmp );
    $i++;
    if ( $source =~ m:/: ) {			# if multi level path
      @tmp = split ( '/', $source );		# get the file off the
      $tmp=pop @tmp;
      $source = join ('/', @tmp );	# end of the path statement
    } else {					# else
      $source = '.';				# null path
    } # end if multipath
  }
  foreach $tmp (<LOCal>) {
    &Dprint (5,$tmp);
    ( $ssize[$i], $smo[$i], $sday[$i], $shr[$i], $sname[$i], $slink[$i] )=
	&SplitList ( $tmp );
    $i++;
  } # end foreach <LOCal>
  close LOCal;
###
############## if the source is a directory or a target file exist matching source
#############    if not directory
#############    then prime target stack with 'total'
#############  continue with 'LS' command
  $i = 0;
  $tmp = $target;			# target name
  if (( $stype ) || 			# if source = dir
			# sense is reversed = IF
	( !( system ("$SSDIR/ssh $C$RmHost test -e $target/$sname[1]")))) {
    unless ( $stype ) {			# if file ( false )
      $tmp = "total 1\n";			# dummy total
      &Dprint (5,$tmp);
      ( $tsize[$i], $tmo[$i], $tday[$i], $thr[$i], $tname[$i], $tlink[$i] )=
	&SplitList ( $tmp );
      $i++;
      $tmp = $target.'/'.$sname[$i];     # real target FILE name
    } # end normal if dir * target file exist

    open ( REMote, "$SSDIR/ssh $C$RmHost $List $tmp |" );
    foreach $tmp (<REMote>) {
    &Dprint (5,$tmp);
    ( $tsize[$i], $tmo[$i], $tday[$i], $thr[$i], $tname[$i], $tlink[$i] )=
	&SplitList ( $tmp );
    $i++;
    } # end foreach <REMote>
    close REMote;
    $stype = 1;			# from now on, recursive entries are directories
  } # end if dir or existing target
####### parse each file for action - ignore, create, update, recurse
  $i=1;						# constant !!;
  while ( $#sname >= $i ) {				# for each source filename
    if (( $j = &MatchTarget )) {		# if there is a matching target
#	test for file classificaton
#	~	backup		delete
#	*	executable	test current
#	/	directory	recurse
#	@	link		test current - re-link
#	|	fifo		ignored
#	=	socket		ignored
      $class = chop ( $file = $sname[$i] );
      &Dprint (3,"mc=$file$class \:\t ");
      if ( $class eq '~' ) {			# if backup
	&Dprint (3,"delete backup");
	&DELETE ( $file.$class );		# delete the backup file

      } elsif ( $class eq '/' ) {		# if directory
	&Dprint (3,"directory");
	if ( defined $Recurs ) {		# and if recursion is on
	  &Dprint (3," recurse $file $class\n");
			# recurse directory
	  &Putf ( $source.'/'.$file, $target.'/'.$file );
	  &Dprint (3,"done recursion");
	} # end recursion

      } elsif ( $class eq '@' ) {		# if link
	&Dprint (3,"link");
	unless ( $slink[$i] eq $tlink[$j] ) {	# unless identical, re-link
	  &Dprint (3,"\-relink to $slink[$i] was $tlink[$j] \<\=");
	  unless ( $tlink[$j] =~ /\@$/ ) {	# but is not a link
	    &REMove ( $target.'/'.$file );	# then remove if was not link
	  }
	  &MAKlink ( $slink[$i], $target.'/'.$file );
	} # end unless re-linking

      } elsif ( $class eq '|' ) {		# found fifo, ignore
	&Dprint (3,"ignor fifo");
	$class = '|';				# nop

      } elsif ( $class eq '=' ) {		# found socket, ignore
	&Dprint (3,"ignor socket");
	$class = '=';				# nop

      } elsif ( $class !~ m:$c_not_e: ) {	# not class except '*'
	if ( $class ne '*' ) {			# if not executable
	  $file = $sname[$i];			# file = file without class
	  $class = '';
	} # end not *
	unless ( &PerfectMatch ) {		# but not perfect match
	  &Dprint (3,' rp');
	  &DELETE ( $file );			# replace
	  &SEND ( $file )
	} # end unless prefect match
	&Dprint (3,"stand/exe");     		# found standard or executable
      } # end case of class
      &POPtarget;				# remove file from target list
    } else { # is not 'MatchTarget'

################ SEND UNMATCHED SOURCE FILES ###################
      &Dprint (3,"sc=$sname[$i] \:\t ");
      unless (( $class=chop ($file = $sname[$i])) =~ m:$c_bfs: ) { # unless fifo,sock,bak
	if ( $class eq '@' ) {				# if link
	  &Dprint (3," link");
	  &MAKlink ( $slink[$i], $target.'/'.$file );
	} else {					# then plain or class

	  if ( $class !~ m:$c_any: ) {			# if not any class
	    $file = $sname[$i];	
	    $class = '';				# file= file without class
	  } # end not class
	  if (( $class eq '/' ) &&			# if a directory
	      !( defined ( $Recurs ))) {		# but NO recursion
	    &Dprint (3," no recurs");
	  } else {
	    &Dprint (3," p,x,/");
	    &SEND ( $file );				# send file/directory recursively
	  } # end if directory or plain, exe
	} # end if link/class/plain
	&Dprint (3," unmatched");
      } else { # is fifo sock bak
	&Dprint (3,"ignor");
      } # end unless pipe,socket, backup
    } # end MatchTarget
    &POPsource;						# remove file from source list
    &Dprint (3,"\t$file$class\n");
  } # end while each filename

################### DELETE UNMATCHED TARGET FILES #################
# any file, directory or link on target list should not be there so remove it
  $j=1;							# constant !!
  while ( $#tname >= $j ) {				# for each target filename
    &Dprint (3,"tc=$tname[$j]\t");
    if (( $class = chop ($file = $tname[$j])) !~ m:$c_fs: ) {	# if not fifo or socket
      if ( $class !~  m:$c_any:) {				# not any class
	$file = $tname[$j];				# file = file without class
	$class = '';
      } # end if class
      &Dprint (3," remove");
      if ( $class eq '~' ) {				# if backup
	&DELETE ( $file.$class );			# need ~
      } else {
	&DELETE ( $file );				# remove filename
      } # end if backup
    } else {
      &Dprint (3," ignore");
    } # end if not pipe/socket
    &Dprint (3,"\t$file$class\n");
    &POPtarget;						# remove file from target list
   } # end while target files

#   if ( defined $Debug ) {
#     for ( $dbp=0; $dbp < $#tsize; $dbp++ ) {
#     print "$tsize[$dbp],$tmo[$dbp],$tday[$dbp],$thr[$dbp],$tname[$dbp],$tlink[$dbp]\n";
#     } # end for debug printing
#   } # end if debug

############# process SEND, DELETE lists ############
  foreach $i ( @DELetlst ) {
    $DELetlst = $DELetlst." \\\n".$target.'/'.$i;
  }
#  &Dprint (4, "$DELetlst\n");
  &REMove ( $DELetlst );			# execute ssh rm files
###
  foreach $i ( @SENDlist ) {
    $SENDlist = $SENDlist." \\\n".$source.'/'.$i;
  }
#  &Dprint (4, "$SENDlist\n");
  &COpy ( $SENDlist );				# execute scp files
} # end Putf

########################################################
# 'POPsource'
# Subroutine take a single listing line out of source arrays
#
sub POPsource {
  splice ( @sname, $i, 1 );
  splice ( @ssize, $i, 1 );
  splice ( @smo, $i, 1 );
  splice ( @sday, $i, 1 );
  splice ( @shr, $i, 1 );
  splice ( @slink, $i, 1 );
}
########################################################
# 'POPtarget'
# Subroutine take a single listing line out of target arrays
#
sub POPtarget {
  splice ( @tname, $j, 1 );
  splice ( @tsize, $j, 1 );
  splice ( @tmo, $j, 1 );
  splice ( @tday, $j, 1 );
  splice ( @thr, $j, 1 );
  splice ( @tlink, $j, 1 );
}
########################################################
# 'MatchTarget'
# Subroutine to match a name from the source list
# to the target list.
#
# Input:	none, uses global variables
# Return:	index into target list or '0'
#
sub MatchTarget {
  local ( $j );
  for ( $j=1; $j <= $#tname; $j++ ) {		# for each target name
    if ( $sname[$i] eq $tname[$j] ) {		# if name matches
      return ($j);				# return index to target
    }
  }
  return (0);					# else return false
} # end MatchTarget
########################################################
# 'PerfectMatch'
# Subroutine returns true/false on perfect match
# of 'source' and 'target'
#
sub PerfectMatch {
  return     (( $ssize[$i]	eq	$tsize[$j] )	&&
	      ( $smo[$i]	eq	$tmo[$j] )	&&
              ( $sday[$i]	eq	$tday[$j] )	&&
              ( $shr[$i]	eq	$thr[$j] )	&&
              ( $slink[$i]	eq	$tlink[$j] ))
} # end PerfectMatch
########################################################
# 'SplitList'
# Subroutine to Split the 'list dir' items into
# 'size, mo, day, hr, name, link'
#
# Input:	directory listing line
# Return:	size, mo, day, hr, name, link
#
sub SplitList {
  local ( *tmp );
  chop ( $tmp = $_[0] );
  local ( $perms, $blks, $users, $group, $size, $mo, $day,
	$hr, $name, $arrow, $link ) = split ( /\s+/, $tmp );
  if ( $name =~ m:/+\S: ) {		# if this was a long listing file
    @tmp = split ( '/', $name );	# extract just the file name
    $name = $tmp[$#tmp];
  }
  if ( $arrow eq '->' ) {				# if this is a link
    if (( chop ($tmp = $link)) =~ m:\~|\*|/|\@|\||\=: ) {	# if classified
      $link = $tmp;					# link without class
    }
      return ( $size, $mo, $day, $hr, $name.'@', $link )
  } else {
    return ( $size, $mo, $day, $hr, $name, $link );
  }
} # end SplitList
########################################################
# 'Dprint'
# Subroutine to print Debug info
#
# Input:	string
#
sub Dprint {
  if ( defined $Debug ) {
    if ( $_[0] <= $Debug ) { print "$_[1]"; }
  }
}
########################################################
# 'CheckSwitches'
# Subroutine to set debugging and transfer flags
#
sub CheckSwitches {
  if ( defined $Debug ) {			# if Debug is defined
    if ( $Debug =~ /no|0/i ) {			# if turned off
      undef $Debug;				# undef it for flag
    } elsif ( $Debug =~ /\D+/ ) {		# if any alpha characters
      $Debug = 99;				# set to a big number
    } # end set debug
  }
  &Dprint (2,"Debug level is $Debug\n");

  if (( defined $Transfer ) && ( $Transfer !~ /off|no|0/i )) {
    $Transfer = 'ON';
  } else {
    $Transfer = 'OFF'
  }
  &Dprint (2,"Transfers are $Transfer\n");
  if ( defined $Recurs ) {
    $RC = 'r';					# GLOBAL switch for copy
    &Dprint (2,"Recursion is $Recurs\n");
  } else {
    &Dprint (2,"Recursion is OFF\n");
  }
}
###########################################################
# 'Help'
# subroutine to print 'help'
#
sub Help {
  print << "ENDhelp";
useage: ssm [-AChrxvd] source user\@remotehost targetdir

	source		  valid directory or file  name.
			  wildcards are not allowed.
	user\@remotehost   host user @ domain
			  must be password free or use
			  ssh-agent so passphrase is not needed
	targetdir	  valid directory on remote host
 --------------------------------------------------------------
      options
	-A		  transfer all files in directories,
			  except for  .'  and ..'
	-C		  enable compression
	-h		  print this 'help' and exit
	-r,R		  recurse down directory tree
	-v,V		  print version number and exit
	-w		  do NOT wait for child processes to close
	-x		  turn off transfers but show proposed
			  action ( if debug is on )
	-dn		  set debug level, must be LAST option
			  if specified as -xxxdn
where 	'n' includes all lower levels
	 0	off ( default ), no messages
	 1	print total transfers, deletions and links
		doesn't count files in recursed directories
	 2	+show debug and transfer status
	 3	+matches, links, replacements, transfers, etc..
	 4	+send, link, and delete commands
	 5	+list source and target directories

	$version $author
ENDhelp
}
########################################################
# 'DELETE'
# Subroutine to build remove list for a
# 'target' directory level
#
# Input: file or directory to remove
#
sub DELETE {
  &Dprint (3," del");
  unshift ( @DELetlst, $_[0] );		# add item to delete list
  $delcnt++;				# update delete count
} # end DELETE
########################################################
# 'SEND'
# Subroutine to build send list for a
# 'target' directory level
#
# Input: file or directory to send
#
sub SEND {
  &Dprint (3," snd");
  unshift ( @SENDlist, $_[0] );		# add to SEND list
  $xfrcnt++;				# update transfer count
}
########################################################
################ SSH REMOTE COMMANDS ###################
########################################################
# 'FORK'
# Subroutine called by other 'ssh' remote commands to 'fork'
#
# Input:	command
#
sub FORK {
  local ( $cmd ) = $_[0];
    &Dprint (4,"\n$cmd\n");
    if ( $Transfer eq 'ON' ) {
#	fork and test
        if ($pid = fork) {
           #parent
        push ( @pidlist, $pid );	# save the pid of child
        } else {
           #child
           exec "$cmd";
           exit 0;
        } # end fork
    } # end if Transfer
} # end of FORK
########################################################                 
# 'REMove'
# Subroutine to remove file(s) or directory(s)
#
# Input:	target file list
#
sub REMove {
  local ( $target ) = $_[0];
#	have to wait for 'remove' before initiating copy
#	else bad things can happen if the names of
#	directories, links and regular files get mixed up
#	and a file with the same name is written and the REMove
#	process has not completed and returned
  unless ( $target eq '' ) {		# ignor empty lists
    local ( $cmd ) = ( "$SSDIR/ssh $C$RmHost $Remove $target\n" );
    &Dprint (4,"$cmd\n");
    if ( $Transfer eq 'ON' ) {
      system ( $cmd );
    } # end if Transfer
  } # end ignor empty
} # end REMove
########################################################
# 'COpy'
# Subroutine to recursively copy  file(s) 
# or directory(s) to the remote host
#
# Input:	source file(s)
#
sub COpy {
  local ( $source ) = $_[0];
  unless ( $source eq '' ) {		# ignor empty strings
    local ( $cmd ) = "$SSDIR/scp -p$RC $C$source $RmHost\:$target\n";
    &FORK ( $cmd );
  } # end ignor empty
} # end COpy
########################################################
# 'MAKlink'
# Subroutine to unconditionally create link in target directory
#
# Input:	link, target path/file
#
sub MAKlink {
  local ( $link, $target ) = @_;
  local ( $cmd ) = "$SSDIR/ssh $C$RmHost $Link $link $target \&\n";
  &FORK ( $cmd );
  $lnkcnt++;				# update the link count
} # end MAKlink
## END 'ssm'
