#!/usr/bin/perl

# Copyright (c) 1998, Jeremy D. Zawodny <jzawodn@wcnet.org>
#
# This file is licensed under the same terms as Perl iself.
#
# $Id: wcftp.pl,v 1.8 1998/11/06 00:58:36 jzawodn Exp $
#
# Get and put files on an arbitrary FTP server.

# Modules

use Net::FTP;
use Cwd;
use Getopt::Std;

# Settings and command-line

my %opts = ();
getopts('dvpgz:c:', \%opts);

my $debug   = $opts{'d'};
my $verbose = $opts{'v'};
my $get     = $opts{'g'};
my $put     = $opts{'p'};
my $config  = $opts{'c'};

# If the user specified a config file, use it. Otherwise
# check for one in their home directory.

if ((not $config) and (-e "$ENV{'HOME'}/.wcftp" )) {
  $config   = "$ENV{'HOME'}/.wcftp";
}

# Config file is required, because we don't allow passwords
# on the command-line.

die "Config file required. Use '-c <path_to_file>'.\n" unless $config;

# Read/Run the user's config file.

require "$config" or die "$!";

die "Relative directory required.\n" unless $rel_dir;

# Setup username/password stuff depending on whether or not there
# is a firewall to deal with.

my $ftp_host;
my $ftp_user;
my $ftp_pass;

if ($fw_host) {
  # We're useing aftpd
  $ftp_host = $fw_host;
  $ftp_user = "$rm_user\@$fw_user\@$rm_host";
  $ftp_pass = "$rm_pass\@$fw_pass";
} else {
  # We're going direct to the remote host
  $ftp_host = $rm_host;
  $ftp_user = $rm_user;
  $ftp_pass = $rm_pass;
}

# Get started...

if ($get and $put) {
  die "Either [g]et or [p]ut. Not both!";
}

my $dir = cwd;
$dir = strip_path($dir);

print "Connecting to server.\n" if ($debug or $verbose);

my $ftp;

if ($ftp = Net::FTP->new("$ftp_host",Debug=>$debug)) {
  print "Connected.\n" if ($debug or $verbose);
} else {
  print "Couldn't connect. [$@]\n";
  exit 5;
}
 
print "Logging in to server.\n" if ($debug or $verbose);

if ($ftp->login("$ftp_user","$ftp_pass")) {
  print "Login successful.\n" if ($debug or $verbose);
} else {
  print "Login failed.\n";
  exit 10;
}

if ($rm_dir) {
  $dir = "$rm_dir/$dir";
}

print "Changing directory to [$dir].\n" if ($debug or $verbose);

if ($dir) {
  if ($ftp->cwd($dir)) {
    print "Directory change successful.\n" if ($debug or $verbose);
  } else {
    print "Directory change failed. Attempting to create path.\n";
    if ($ftp->mkdir($dir,1)) {
      print "Directory creation successful.\n" if ($debug or $verbose);
      print "Changing directory to [$dir].\n" if ($debug or $verbose);
      if ($ftp->cwd($dir)) {
        print "Directory change successful.\n" if ($debug or $verbose);
      }
    } else {
      exit 15;      
    }
  }
}

my $file;
my $type;
foreach $file (@ARGV) {
  $type = guess_file_type($file);
  print "File [$file] is [$type].\n" if ($debug or $verbose);

  if ($type eq "ascii") {
    $ftp->ascii;
  } else {
    $ftp->binary;
  }

  print "Transfering file.\n" if ($debug or $verbose);

  if ($put) {
    if ($ftp->put($file)) {
      print "Transfer successful. [$file]\n";
    } else {
      print "Transfer failed. [$@]\n";
    } # end put
  } elsif ($get) {
    if ($ftp->get($file)) {
      print "Transfer successful. [$file]\n";
    } else {
      print "Transfer failed. [$@]\n";
    } # end get
  } # end put or get
}

print "Disconnecting.\n" if ($debug or $verbose);

$ftp->quit;

exit;

##################################################
# Strip Path
##################################################

sub strip_path ($) {
  my $path = shift;
  $path =~ m|(.*)/$rel_dir/(.*)|;
  my $relative_path = $2;
  print "relative path appears to be [$relative_path]\n" if $debug;
  if ($rel_app) {
    $relative_path = "$rel_app/$relative_path";
    print "added $rel_app to path, now [$relative_path]\n" if $debug;
  }
  return $relative_path;
}

#################################################
# Guess File Type
#################################################

sub guess_file_type ($) {
  my $filename = shift;
  $filename =~ m|\.(.*)$|;
  my $extension = $1;
  
  if ($extension =~ /(txt|htm|html)/oi) {
    return "ascii";
  }

  if (-T $filename) {
    return "ascii";
  }

  return "binary";

}

=head1 NAME

wcftp - a script to automate the process of FTPing files.

=head1 DESCRIPTION

This script automates the process of FTPing groups of files from one
computer to another (with some degree of firewall support). While
originally written for my own use in moving my personal Web content
from my home LAN to my ISP, I found a use for it at work, too.

B<wcftp> has support for CheckPoint's aftpd (Secure FTP gateway) in
Firewall-1.

B<wcftp> makes some assumptions that you may or may not agree with,
but they work well in my situations. The most important of those
assumptions is that your are maintaining Web content (or other files)
in a staging area whose directory structure mirrors that of your
production server.

The name C<wcftp> is supposed to mean something like Web Content FTP.

This is not intended in any way to replace the full-featured mirroring
packages which are available for heavy-duty work. B<wcftp> is meant as
a relatively small and simple solution to a simple problem.

=head1 PREREQUISITES

This script requires C<Cwd> module, the C<Net::FTP> module, and
C<Getopt::Std>.

=head1 COREQUISITES

None

=head1 OSNAMES

This script is known to work on C<Win95>, C<WinNT>, and C<linux>.
Given the generic nature of it, it probably works on most Unixes.

=head1 README

If there is any text in this section, it will be extracted into
a separate README file.

=head1 USAGE

wcftp takes several command-line arguments. Some of those arguments
can be stored in a configuration file (C<$HOME/.wcftp>) so that they can
be used automatically.

=head2 Command-Line Parameters

=over

=item B<-d>

Debugging. Enable debugging messages. This turns on wcftp's built-in
debugging and also switches debugging on in Net::FTP.

=item B<-v>

Verbosity. Turns on verbose messages. Try it and see.

=item B<-g>

Get.

=item B<-p>

Put.

=item B<-c>

Config file.

=back

=head2 Configuration File

The configuration file is simple a file which contains valid Perl
code. Typically, you would set some variables which B<wcftp> can make
use of to figure out how you want things done.

What follows is a list of the variables that it currently understands.

=over

=item B<$rm_host>

Remote (destination) hostname/IP address.

=item B<$rm_user>

Username on the remote (destination) host.

=item B<$rm_pass>

Password on the remote (destination) host.

=item B<$fw_host>

Firewall hostname/IP address.

=item B<$fw_user>

Username on the firewall.

=item B<$fw_pass>

Password on the firewall.

=item B<$rm_dir>

Remote directory prefix.

=item B<$rel_dir>

Relative [local] directory.

=back

=head2 Sample Configuration File

Here's a sample configuration file. This file would be useful in the
following situations:

Unix:

=over

=item *

You've saved this config file in C<~/.wcftp>

=item *

Your local staging area is in C</webstuff/staging/>

=back

Windows:

=over

=item *

You have defined the C<HOME> environment variable to point to the
directory in which this config file resides as C<.wcftp>.

=item *

Your local staging area is in C<D:\webstuff\staging>

=back

Here's the file:

 # wcftp config file
 #
 # firewall stuff
 #
 $fw_host = "firwall.blah.com";
 $fw_user = "jimbo";
 $fw_pass = "PaSsWoRd";
 #
 # remote stuff
 #
 $rm_host = "www.realblah.com";
 $rm_user = "webadmin";
 $rm_pass = "pAsSwOrD";
 #
 # directory structure
 #
 $rm_dir  = "public_html";
 $rel_dir = "staging";
 #
 1;

You could simply change to your staging directory and run B<wcftp>
like this:

 perl wcftp.pl *.html *.gif

As you might have guessed, the config file above assumes that you have
a Checkpoint Firewall-1 box with their aftpd running on it. It also
assumes that C<~webadmin/public_html> on C<www.realblah.com> is where
your content belongs.

=head1 SCRIPT CATEGORIES

In the CPAN script archive, you can find B<wcftp> in C<CPAN/Misc>.

=head1 BUGS

There are no known bugs yet.

=head1 AUTHOR AND COPYRIGHT

This script is Copyright 1998, Jeremy D. Zawodny
E<lt>jzawodn@wcnet.orgE<gt>. It is free software which is
redistributable under the same terms as Perl itself.

This and other scripts are available on my Perl Web page:
http://www.wcnet.org/~jzawodn/perl

=cut

__END__
