Net::FTP, Configure

- First attempt to add multiple firewall type support

2 files changed, 145 insertions, 53 deletions

diff --git a/Configure b/Configure
index 64b19e4..51adb87 100755
--- a/Configure
+++ b/Configure
@@ -353,20 +353,68 @@ $cfg{'daytime_hosts'} = get_host_list($msg,$def);
 #---------------------------------------------------------------------------
 
 $msg = <<EDQ;
+Do you have a firewall/ftp proxy  between your machine and the internet 
 
-Some companies access the internet via a firewall machine, and all
-FTP access must be dove via this machine.
+If you use a SOCKS firewall answer no
 
-If to gain FTP access to a machine beyond a firewall, you have to use
-a FTP proxy machine and login as username\@remote.host then enter
-the name of that gateway here.
+(y|n) ?
+EDQ
 
-FTP proxy hostname :
+if(get_bool($msg,0)) {
+
+  $msg = <<'EDQ';
+What series of FTP commands do you need to send to your
+firewall to connect to an external host.
+
+user/pass     => external user & password
+fwuser/fwpass => firewall user & password
+
+0) None
+1) -----------------------
+     USER user@remote.host
+     PASS pass
+2) -----------------------
+     USER fwuser
+     PASS fwpass
+     USER user@remote.host
+     PASS pass
+3) -----------------------
+     USER fwuser
+     PASS fwpass
+     SITE remote.site
+     USER user
+     PASS pass
+4) -----------------------
+     USER fwuser
+     PASS fwpass
+     OPEN remote.site
+     USER user
+     PASS pass
+5) -----------------------
+     USER user@fwuser@remote.site
+     PASS pass@fwpass
+6) -----------------------
+     USER fwuser@remote.site
+     PASS fwpass
+     USER user
+     PASS pass
+7) -----------------------
+     USER user@remote.host
+     PASS pass
+     AUTH fwuser
+     RESP fwpass
 EDQ
+ $def = exists $oldcfg{'ftp_firewall_type'}  ? $oldcfg{'ftp_firewall_type'} : 1;
+ $ans = Prompt($msg,$def);
+ $cfg{'ftp_firewall_type'} = 0+$ans;
+ $def = $oldcfg{'ftp_firewall'} || $ENV{FTP_FIREWALL};
 
-$def = $oldcfg{'ftp_firewall'} || $ENV{FTP_FIREWALL};
+ $cfg{'ftp_firewall'} = get_hostname("FTP proxy hostname :", $def);
+}
+else {
+ delete $cfg{'ftp_firewall'};
+}
 
-$cfg{'ftp_firewall'} = get_hostname($msg,$def);
 
 #---------------------------------------------------------------------------
 
@@ -424,16 +472,21 @@ protocol. In these situations the client must make the connection to the
 server, this is called a passive transfer.
 EDQ
 
-$msg = "\nShould all FTP connections via a firewall/proxy be passive (y|n) ?";
+if (defined $cfg{'ftp_firewall'}) {
+  $msg = "\nShould all FTP connections via a firewall/proxy be passive (y|n) ?";
 
-$def = $oldcfg{'ftp_ext_passive'} || 0;
+  $def = $oldcfg{'ftp_ext_passive'} || 0;
 
-$cfg{'ftp_ext_passive'} = get_bool($msg,$def);
+  $cfg{'ftp_ext_passive'} = get_bool($msg,$def);
 
+  $msg = "\nShould all other FTP connections be passive (y|n) ?";
 
-$def = $oldcfg{'ftp_int_passive'} || 0;
+}
+else {
+  $msg = "\nShould all FTP connections be passive (y|n) ?";
+}
 
-$msg = "\nShould all other FTP connections be passive (y|n) ?";
+$def = $oldcfg{'ftp_int_passive'} || 0;
 
 $cfg{'ftp_int_passive'} = get_bool($msg,$def);
 
diff --git a/Net/FTP.pm b/Net/FTP.pm
index bc7ed20..d744f05 100644
--- a/Net/FTP.pm
+++ b/Net/FTP.pm
@@ -21,7 +21,7 @@ use Net::Cmd;
 use Net::Config;
 # use AutoLoader qw(AUTOLOAD);
 
-$VERSION = "2.53"; # $Id: //depot/libnet/Net/FTP.pm#40 $
+$VERSION = "2.53"; # $Id: //depot/libnet/Net/FTP.pm#41 $
 @ISA     = qw(Exporter Net::Cmd IO::Socket::INET);
 
 # Someday I will "use constant", when I am not bothered to much about
@@ -220,62 +220,101 @@ sub size {
  undef;
 }
 
-sub login
-{
- my($ftp,$user,$pass,$acct) = @_;
- my($ok,$ruser);
+sub login {
+  my($ftp,$user,$pass,$acct) = @_;
+  my($ok,$ruser,$fwtype);
 
- unless (defined $user)
-  {
-   require Net::Netrc;
+  unless (defined $user) {
+    require Net::Netrc;
 
-   my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_host'});
+    my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_host'});
 
-   ($user,$pass,$acct) = $rc->lpa()
-        if ($rc);
-  }
+    ($user,$pass,$acct) = $rc->lpa()
+         if ($rc);
+   }
 
- $user ||= "anonymous";
- $ruser = $user;
+  $user ||= "anonymous";
+  $ruser = $user;
 
- if(defined ${*$ftp}{'net_ftp_firewall'})
-  {
-   $user .= '@' . ${*$ftp}{'net_ftp_host'};
+  $fwtype = $NetConfig{'ftp_firewall_type'} || 0;
+
+  if ($fwtype && defined ${*$ftp}{'net_ftp_firewall'}) {
+    if ($fwtype == 1 || $fwtype == 7) {
+      $user .= '@' . ${*$ftp}{'net_ftp_host'};
+    }
+    else {
+      require Net::Netrc;
+
+      my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_firewall'});
+
+      my($fwuser,$fwpass,$fwacct) = $rc ? $rc->lpa() : ();
+
+      if ($fwtype == 5) {
+        $user = join('@',$user,$fwuser,${*$ftp}{'net_ftp_host'});
+        $pass = $pass . '@' . $fwpass;
+      }
+      else {
+        if ($fwtype == 2) {
+          $user .= '@' . ${*$ftp}{'net_ftp_host'};
+        }
+        elsif ($fwtype == 6) {
+          $fwuser .= '@' . ${*$ftp}{'net_ftp_host'};
+        }
+
+        $ok = $ftp->_USER($fwuser);
+
+        return 0 unless $ok == CMD_OK || $ok == CMD_MORE;
+
+        $ok = $ftp->_PASS($fwpass || "");
+
+        return 0 unless $ok == CMD_OK || $ok == CMD_MORE;
+
+        $ok = $ftp->_ACCT($fwacct)
+          if defined($fwacct);
+
+        if ($fwtype == 3) {
+          $ok = $ftp->command("SITE",${*$ftp}{'net_ftp_host'})->response;
+        }
+        elsif ($fwtype == 4) {
+          $ok = $ftp->command("OPEN",${*$ftp}{'net_ftp_host'})->response;
+        }
+
+        return 0 unless $ok == CMD_OK || $ok == CMD_MORE;
+      }
+    }
   }
 
- $ok = $ftp->_USER($user);
+  $ok = $ftp->_USER($user);
 
- # Some dumb firewalls don't prefix the connection messages
- $ok = $ftp->response()
-        if($ok == CMD_OK && $ftp->code == 220 && $user =~ /\@/);
+  # Some dumb firewalls don't prefix the connection messages
+  $ok = $ftp->response()
+         if ($ok == CMD_OK && $ftp->code == 220 && $user =~ /\@/);
 
- if ($ok == CMD_MORE)
-  {
-   unless(defined $pass)
-    {
-     require Net::Netrc;
+  if ($ok == CMD_MORE) {
+    unless(defined $pass) {
+      require Net::Netrc;
 
-     my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_host'}, $ruser);
+      my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_host'}, $ruser);
 
-     ($ruser,$pass,$acct) = $rc->lpa()
-        if ($rc);
+      ($ruser,$pass,$acct) = $rc->lpa()
+         if ($rc);
 
-     $pass = "-" . (eval { (getpwuid($>))[0] } || $ENV{NAME} ) . '@'
-        if (!defined $pass && (!defined($ruser) || $ruser =~ /^anonymous/o));
+      $pass = "-" . (eval { (getpwuid($>))[0] } || $ENV{NAME} ) . '@'
+         if (!defined $pass && (!defined($ruser) || $ruser =~ /^anonymous/o));
     }
 
-   $ok = $ftp->_PASS($pass || "");
+    $ok = $ftp->_PASS($pass || "");
   }
 
- $ok = $ftp->_ACCT($acct)
-        if (defined($acct) && ($ok == CMD_MORE || $ok == CMD_OK));
+  $ok = $ftp->_ACCT($acct)
+         if (defined($acct) && ($ok == CMD_MORE || $ok == CMD_OK));
 
- if($ok == CMD_OK && defined ${*$ftp}{'net_ftp_firewall'}) {
-   my($f,$auth,$resp) = _auth_id($ftp);
-   $ftp->authorize($auth,$resp) if defined($resp);
- }
+  if ($fwtype == 7 && $ok == CMD_OK && defined ${*$ftp}{'net_ftp_firewall'}) {
+    my($f,$auth,$resp) = _auth_id($ftp);
+    $ftp->authorize($auth,$resp) if defined($resp);
+  }
 
- $ok == CMD_OK;
+  $ok == CMD_OK;
 }
 
 sub account
@@ -299,7 +338,7 @@ sub _auth_id {
         || Net::Netrc->lookup(${*$ftp}{'net_ftp_firewall'});
 
    ($auth,$resp) = $rc->lpa()
-     if($rc);
+     if ($rc);
   }
   ($ftp,$auth,$resp);
 }