mccopy.pl

hl2 source code. Do not use it illegal.

# todo: make sure and create the target directory if it doesn't exist.
# todo: make this work either direction
# todo: fix any case problems

$g_protocol_version = "mccopy1\n";
$g_opt_port = 7070;

use IO::Socket;

sub GetMD5
{
	local( $filename ) = shift;
	$filename =~ s,/,\\,g;
#	print "$filename\n";
	print ".";
	local( $cmd ) = "md5.exe < \"$filename\"";
#	print $cmd . "\n";
	open MD5, "$cmd|";
	$out = <MD5>;
	close MD5;
	$out =~ s/^.*\=\s+//;
	$out =~ s/\n//g;
#	print "'" . $out . "'" . "\n";
	return $out;	
}

################################################################################################
# SERVER CODE
################################################################################################
sub SendFileName
{
	local( $sock ) = shift;
	local( $file ) = shift;
	local( $isdir ) = -d $file;

	if( $isdir )
	{
		if( $file =~ m/\/\.$/ ||		# "."
			$file =~ m/\/\.\.$/ )	# ".."
		{
			return;
		}
	}

	local( @statinfo ) = stat $file;
	if( @statinfo )
	{
		local( $mtime ) = $statinfo[9];
		local( $mode ) = $statinfo[2];
#		local( $mtimestr ) = scalar( localtime( $mtime ) );
		local( $size ) = $statinfo[7];
		if( $isdir )
		{
			print $sock "d\n";
		}
		else
		{
			print $sock "f\n";
		}
		print $sock &RemoveBaseDir( $file ) . "\n";
		print $sock $mtime . "\n";
		printf $sock "%o\n", $mode;
		print $sock $size . "\n";
		if( !$isdir && $g_server_md5 )
		{
			print $sock &GetMD5( $file ) . "\n";
		}
#		print $file . "\n";
#		print $mtime . "\n";
#		print $mode . "\n";
#		print $md5 . "\n";
	}
	else
	{
		print "CAN'T STAT $file\n";
	}

	if( $isdir )
	{
		SendDirName( $sock, $file );
	}
}


sub SendDirName
{
	local( $sock ) = shift;
	local( $dirname ) = shift;
	if( $dirname =~ m/\/\.$/ ||		# "."
	    $dirname =~ m/\/\.\.$/ )	# ".."
	{
		return;
	}

	local( *SRCDIR );
	opendir SRCDIR, $dirname;
	local( @dir ) = readdir SRCDIR;
	closedir SRCDIR;

	local( $item );
	while( $item = shift @dir )
	{
		&SendFileName( $sock, $dirname . "/" . $item );
	}
}

sub GetFile
{
	local( $sock ) = shift;
	local( $filename ) = shift;
	local( $localfilename ) = &AddBaseDir( $filename );
	print "GetFile: $filename ($localfilename)\n";
	local( *FILE );
	open FILE, "<$localfilename";
	binmode( FILE );
	local( $filebits );
	seek FILE, 0, 2;
	local( $size ) = tell FILE;
	if( $size < 0 )
	{
		die "$filename \$size == $size\n";
	}
	seek FILE, 0, 0;
	read FILE, $filebits, $size;
	close FILE;
#	print "sending $filename: $size\n";
	print $sock $filebits;
#	print "finished sending $filename\n";
}

sub HandleCommand
{
	local( $sock ) = shift;
	local( $cmd ) = shift;

	if( $cmd =~ m/dirlistmd5\s+(.*)$/ )
	{
		$g_server_md5 = 1;
		&SetBaseDir( $1 );
		&SendDirName( $sock, $1 );
		print $sock "\n"; # terminating newline to end reply
	}
	elsif( $cmd =~ m/dirlist\s+(.*)$/ )
	{
		$g_server_md5 = 0;
		&SetBaseDir( $1 );
		&SendDirName( $sock, $1 );
		print $sock "\n"; # terminating newline to end reply
	}
	elsif( $cmd =~ m/getfile\s+(.*)$/ )
	{
		&GetFile( $sock, $1 );
	}
}

sub RunServer
{
	local( $hostname ) = `hostname`;
#	local( $hostname ) = "localhost";
	$hostname =~ s/\n//; # remove newlines

	my $sock = new IO::Socket::INET (
									  LocalHost => $hostname,
									  LocalPort => $g_opt_port,
									  Proto => 'tcp',
									  Listen => 1,
									  Reuse => 1,
									 );
	die "Could not create socket: $!\n" unless $sock;

	local( $clientnum ) = 0;
	while( 1 )
	{
		my $new_sock = $sock->accept();
		print "accept!\n";
		if( fork() == 0 )
		{
			print "$clientnum: opening connection...\n";
			$version = <$new_sock>;
			if( $version ne $g_protocol_version )
			{
				die "wrong protocol version: server: $g_protocol_version client: %version\n";
			}
			while(defined($command = <$new_sock>)) 
			{
				print "$clientnum: command: $command";
			   	&HandleCommand( $new_sock, $command );
			   	print "$clientnum: done with $command";
			}
			print "$clientnum: closing connection...\n";
			close( $new_sock );
			exit;
		}
		$clientnum++;
	}

	close($sock); # never get here.
}

################################################################################################
# CLIENT CODE
################################################################################################


# all options that we might care about from rsync:
# -v, --verbose               increase verbosity
# -q, --quiet                 decrease verbosity
# -c, --checksum              always checksum
# -a, --archive               archive mode
# -r, --recursive             recurse into directories
# -R, --relative              use relative path names
# -b, --backup                make backups (default ~ suffix)
#     --backup-dir=DIR        put backups in the specified directory
#     --suffix=SUFFIX         override backup suffix
# -u, --update                update only (don't overwrite newer files)
# -p, --perms                 preserve permissions
# -t, --times                 preserve times
# -n, --dry-run               show what would have been transferred
#     --existing              only update files that already exist
#     --delete                delete files that don't exist on the sending side
#     --delete-excluded       also delete excluded files on the receiving side
#     --delete-after          delete after transferring, not before
#     --max-delete=NUM        don't delete more than NUM files
#     --force                 force deletion of directories even if not empty
#     --timeout=TIME          set IO timeout in seconds
# -I, --ignore-times          don't exclude files that match length and time
#     --size-only             only use file size when determining if a file should be transferred
# -T  --temp-dir=DIR          create temporary files in directory DIR
#     --compare-dest=DIR      also compare destination files relative to DIR
# -P                          equivalent to --partial --progress
# -z, --compress              compress file data
#     --exclude=PATTERN       exclude files matching PATTERN
#     --exclude-from=FILE     exclude patterns listed in FILE
#     --include=PATTERN       don't exclude files matching PATTERN
#     --include-from=FILE     don't exclude patterns listed in FILE
#     --version               print version number
#     --daemon                run as a rsync daemon
#     --address               bind to the specified address
#     --stats                 give some file transfer stats
#     --progress              show progress during transfer
# -h, --help                  show this help screen

# options that are actually implemented:
#
sub Usage
{
	print "\n";
	print "Usage:\n";
	print "perl McCopy.pl --server\n";
	print "or\n";
	print "perl McCopy.pl [options] srcdir dstdir\n";
	print "\n";
	print "ie:\n";
	print "perl McCopy.pl --verbose --mirror-safe --test remotemachine:u:/hl u:/hl.work\n";
	print "\n";
	print "where \"remotemachine\" is running a McCopy server\n";
	print "\n";
	print "options are:\n";
	print "--server              run as server (ignores other options)\n";
	print "--port N (default 7070)\n";
	print "--verbose\n";
	print "--test                don't actually copy or delete any files\n";
	print "--ignore-time         don't use file mtimes as a criterion for file that need\n";
	print "                      to be copied.\n";
	print "--ignore-permissions  don't use file permissions as a criterion for file that\n";
	print "                      need to be copied.\n";
	print "--ignore-size         don't use file size as a criterion for file that need\n";
	print "                      to be copied.\n";
	print "--md5         	     Use md5 checksums\n";
	print "--recursive\n";
	print "--delete-readonly     delete readonly files in dst\n";
	print "                      that don't exist in src\n";
	print "--delete-writable     delete writable files in dst\n";
	print "--delete-dirs         delete directories in dst that don't exist in src\n";
	print "--clobber-writable-newer\n";
	print "                      write over upon copy files that have been modified locally\n";
	print "--delete-excluded     delete files on dst that are excluded using --exclude\n";
	print "--exclude             exclude files containing perl regular expression, ie:\n";
	print "                      --exclude /.*release.*/i\n";
	print "--include             override --exclude for files containing perl regular expression, ie:\n";
	print "                      --include /.*debughlp.*/i\n";
	print "--mirror              same as --recursive --delete-readonly --delete-writable\n";
	print "                      --clobber-writable-newer --delete-excluded --delete-dirs\n";
	print "--mirror-safe         same as --recursive --delete-readonly --delete-dirs\n";
	exit;
}

# default command line options
$g_opt_server = 0;
$g_opt_test = 0;
$g_opt_verbose = 0;
$g_opt_recursive = 0;
$g_opt_deletereadonly = 0;
$g_opt_deletewritable = 0;
$g_opt_clobberwritablenewer = 0;
$g_opt_deleteexcluded = 0;
$g_opt_deletedirs = 0;
$g_opt_ignoretime = 0;
$g_opt_ignoreperms = 0;
$g_opt_ignoresize = 0;
@g_opt_exclude;
@g_opt_include;
$g_opt_src;
$g_opt_dst;

$g_src_is_local;
$g_src_machine = "";
$g_src_path;

$g_dst_is_local;
$g_dst_machine = "";
$g_dst_path;

# indexed by $filename
%g_remote_mtime;
%g_remote_mode;
%g_remote_isdir;
%g_remote_size;

%g_local_mtime;
%g_local_mode;
%g_local_isdir;
%g_local_size;

%g_files_to_delete;
%g_dirs_to_delete;
%g_files_to_copy;
%g_dirs_to_create;

$g_max_time_delta = 2; # in seconds

sub BackToForwardSlash
{
	local( $path ) = shift;
	$path =~ s,\\,/,g;
	return $path;
}

sub ForwardToBackSlash
{
	local( $path ) = shift;
	$path =~ s,/,\\,g;
	return $path;
}

sub SetBaseDir
{
	$g_basedir = shift;
#	print "\$g_basedir: $g_basedir\n";
}

sub RemoveFileName
{
	local( $in ) = shift;
	$in = &BackToForwardSlash( $in );
	$in =~ s,/[^/]*$,,;
	return $in;
}

sub RemovePath
{
	local( $in ) = shift;
	$in = &BackToForwardSlash( $in );
	$in =~ s,^(.*)/([^/]*)$,$2,;
	return $in;
}


sub MakeDirHier
{
	local( $in ) = shift;
#	print "MakeDirHier( $in )\n";
	$in = &BackToForwardSlash( $in );
	local( @path );
	while( $in =~ m,/, ) # while $in still has a slash
	{
		local( $end ) = &RemovePath( $in );
		push @path, $end;
#		print $in . "\n";
		$in = &RemoveFileName( $in );
	}
	local( $i );
	local( $numelems ) = scalar( @path );
	local( $curpath );
	for( $i = $numelems - 1; $i >= 0; $i-- )
	{
		$curpath .= "/" . $path[$i];
		local( $dir ) = $in . $curpath;
		if( !stat $dir )
		{
			print "mkdir $dir\n";
			mkdir $dir, 0777;
		}
	}
}

sub RemoveBaseDir
{
	local( $path ) = shift;
#	print "removebasedir: $path ";
	$path =~ s,^$g_basedir/,,;
#	print "$path\n";
	return $path;
}

sub AddBaseDir
{
	local( $path ) = shift;
	return $g_basedir . "/" . $path;
}

sub FixPath
{
	local( $path ) = shift;
	# backslash to forward slash
	$path =~ s,\\,/,g;  
	# remove trailing slash
	$path =~ s,/$,,;	
	return $path;
}

sub ProcessLongCommand
{
	local( $cmd ) = shift;
	if( $cmd =~ m/--verbose/ )
	{
		$g_opt_verbose = 1;
	}
	elsif( $cmd =~ m/--server/ )
	{
		$g_opt_server = 1;
	}
	elsif( $cmd =~ m/--test/ )
	{
		$g_opt_test = 1;
	}
	elsif( $cmd =~ m/--ignore-time/ )
	{
		$g_opt_ignoretime = 1;
	}
	elsif( $cmd =~ m/--ignore-permissions/ )
	{
		$g_opt_ignoreperms = 1;
	}
	elsif( $cmd =~ m/--ignore-size/ )
	{
		$g_opt_ignoresize = 1;
	}
	elsif( $cmd =~ m/--md5/ )
	{
		$g_opt_md5 = 1;
	}
	elsif( $cmd =~ m/--recursive/ )
	{
		$g_opt_recursive = 1;
	}
	elsif( $cmd =~ m/--mirror-safe/ )
	{
		$g_opt_recursive = 1;
		$g_opt_deletereadonly = 1;
		$g_opt_deletewritable = 0;
		$g_opt_clobberwritablenewer = 0;
		$g_opt_deleteexcluded = 0;
		$g_opt_deletedirs = 1;
	}
	elsif( $cmd =~ m/--mirror/ )
	{
		$g_opt_recursive = 1;
		$g_opt_deletereadonly = 1;
		$g_opt_deletewritable = 1;
		$g_opt_clobberwritablenewer = 1;
		$g_opt_deleteexcluded = 1;
		$g_opt_deletedirs = 1;
	}
	elsif( $cmd =~ m/--delete-readonly/ )
	{
		$g_opt_deletereadonly = 1;
	}
	elsif( $cmd =~ m/--delete-writable/ )
	{
		$g_opt_deletewritable = 1;
	}
	elsif( $cmd =~ m/--clobber-writable-newer/ )
	{
		$g_opt_clobberwritablenewer = 1;
	}
	elsif( $cmd =~ m/--delete-excluded/ )
	{
		$g_opt_deleteexcluded = 1;
	}
	elsif( $cmd =~ m/--delete-dirs/ )
	{
		$g_opt_deletedirs = 1;
	}
}

sub ProcessCommandLine
{
	local( $cmd );
	while( $cmd = shift )
	{
		# hack - special case for exclude since it has an argument
		if( $cmd =~ m/^--exclude/ )
		{
			push @g_opt_exclude, shift;
		}
		elsif( $cmd =~ m/^--include/ )
		{
			push @g_opt_include, shift;
		}
		elsif( $cmd =~ m/^--port/ )
		{
			$g_opt_port = shift;
		}
		elsif( $cmd =~ m/^--/ )
		{
			&ProcessLongCommand( $cmd );
		}
		elsif( $cmd =~ m/^-/ )
		{
			print "short command $cmd\n";
		}
		else
		{
			if( !defined( $g_opt_src ) )
			{
				$g_opt_src = &FixPath( $cmd );
			}
			elsif( !defined( $g_opt_dst ) )
			{
				$g_opt_dst = &FixPath( $cmd );
			}
			else
			{
				print "Don't understand $cmd\n";
				&Usage();
			}
		}
	}
}

sub PrintOptions
{
	if( $g_opt_verbose )
	{
		print "\n";
		print "Options:\n";
		print "\$g_opt_src = $g_opt_src\n";
		print "\$g_opt_dst = $g_opt_dst\n";
		print "\$g_opt_test = $g_opt_test\n";
		print "\$g_opt_ignoretime = $g_opt_ignoretime\n";
		print "\$g_opt_ignoreperms = $g_opt_ignoreperms\n";
		print "\$g_opt_ignoresize = $g_opt_ignoresize\n";
		print "\$g_opt_verbose = $g_opt_verbose\n";
		print "\$g_opt_recursive = $g_opt_recursive\n";
		print "\$g_opt_deletereadonly = $g_opt_deletereadonly\n";
		print "\$g_opt_deletewritable = $g_opt_deletewritable\n";
		print "\$g_opt_clobberwritablenewer = $g_opt_clobberwritablenewer\n";
		print "\$g_opt_deleteexcluded = $g_opt_deleteexcluded\n";
		print "\@g_opt_exclude = @g_opt_exclude\n";
		print "\n";
	}
}

sub ValidateOptions
{
	if( $g_opt_server )
	{
		return;
	}
	if( !defined( $g_opt_src ) )
	{
		print "src not defined\n";
		Usage();
	}
	if( !defined( $g_opt_dst ) )
	{
		print "dst not defined\n";
		Usage();
	}
	if( !$g_opt_recursive )
	{
		print "--recursive must be used. . non-recursive operation not supported\n";
		Usage();
	}
}

# src/dst looks like:
# gary:u:/hl2/hl2
# u:/hl2/hl2
# /hl2/hl2

sub ParseSrcDstPaths
{
#	print $g_opt_src . "\n";
	if( $g_opt_src =~ m/(\S+)\:(\S\:\S*)/ )
	{
		$g_src_is_local = 0;
		$g_src_machine = $1;
		$g_src_path = $2;
	}
	elsif( $g_opt_src =~ m/(\S+)\:(\/\/.*)/ )
	{
		# //gary://maxwell/common/
		$g_src_is_local = 0;
		$g_src_machine = $1;
		$g_src_path = $2;
	}
	elsif( $g_opt_src =~ m/^(\S:.*)/ )
	{
		$g_src_is_local = 1;
		$g_src_path = $1;
	}
	else
	{
		$g_src_is_local = 1;
		$g_src_path = $1;
	}

	if( $g_opt_dst =~ m/(\S+):(\S:\S+)/ )
	{
		$g_dst_is_local = 0;
		$g_dst_machine = $1;
		$g_dst_path = $2;
	}
	elsif( $g_opt_dst =~ m/^(\S:\S+)/ )
	{
		$g_dst_is_local = 1;
		$g_dst_path = $1;
	}
	else
	{
		$g_dst_is_local = 1;
		$g_dst_path = $1;
	}

	if( $g_src_is_local )
	{
		die "local src directories not supported yet. . run the server on the other end.\n";
	}
	if( !$g_dst_is_local )
	{
		die "remote dst directories not supported yet. . run the server on the other end.\n";
	}
	if( $g_src_is_local == $g_dst_is_local )
	{
		die "src and dst on the same machine not supported. . use robocopy\n";
	}