#!/usr/local/bin/perl -w

# Author: Eric Marsden  <emarsden@mail.dotcom.fr>
# Version: 0.1
# Copyright: (C) 2000  Eric Marsden
# Time-stamp: <2000-08-25 emarsden>
#
#      This program is free software; you can redistribute it and/or
#      modify it under the terms of the GNU General Public License as
#      published by the Free Software Foundation; either version 2 of
#      the License, or (at your option) any later version.
#      
#      This program is distributed in the hope that it will be useful,
#      but WITHOUT ANY WARRANTY; without even the implied warranty of
#      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
#      GNU General Public License for more details.
#      
#      You should have received a copy of the GNU General Public
#      License along with this program; if not, write to the Free
#      Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
#      MA 02111-1307, USA.
# 
#  The latest version of this package should be available from
# 
#     <URL:http://www.chez.com/emarsden/downloads/>


# A commandline Squid-enabled ftp client.
#
# Squid <URL:http://www.squid-cache.org/> is a popular free caching
# HTTP proxy which is able to handle FTP requests. Certain
# organizations have firewall configurations which block outbound FTP
# connections, but do allow connections via Squid. While some programs
# such as Netscape are able to use this type of proxy, other programs
# which depend on the standard commandline ftp client (such as Emacs'
# support for transparent ftp file access) don't work.
#
# This program is an attempt to work around this problem. It tries to
# look like the standard Unix ftp client, but instead of opening TCP
# connections to the remote ftp servers, it makes HTTP requests to
# your Squid proxy. It provides only a small subset of the commands
# normally understood by a standard ftp client (indeed, only those
# which are used by Emacs' ange-ftp module).
#
# Consider the data transformations which occur when retrieving a
# remote directory listing using this program and be amazed if it
# happens to work:
#
# 1. remote ftpd uses readdir() and stat() to generate an ASCII
#    directory listing
# 2. Squid retrieves this listing and tranforms it into HTML
# 3. this program reconstructs the ASCII listing from the HTML
# 4. ange-ftp parses the ASCII listing
#
#
# -=- EMACS CONFIGURATION -=-
#
# To configure Emacs to use this program instead of your regular ftp
# client, add something like the following to your ~/.emacs
# initialization file:
#
#    (setq ange-ftp-ftp-program-name "/path/to/squidftp")
#    (setq ange-ftp-program-args nil)
#    (setq ange-ftp-send-hash nil)
#
# If you are using XEmacs the corresponding incantations should be
#
#    (setq efs-ftp-program-name "/path/to/squidftp")
#    (setq efs-ftp-program-args nil)
#    (setq efs-send-hash nil)
#
# 
# The program will determine the address of your FTP proxy by looking
# at the value of the environment variable `ftp_proxy'. Set this in
# your shell's initialization file to something like
#
#    export ftp_proxy=http://webcache:3128/
#
#
# If ange-ftp seems to get hung while retrieving a directory listing,
# or retrieves the same directory many times, try adding the following
# lines to your Emacs initialization file:
#
#    (defadvice ange-ftp-raw-send-cmd (before ecm-ftp-pause activate)
#       (sleep-for 0 100))
# 
#
#
# -=- BUG REPORTS -=-
#
# When reporting bugs related to this program's interaction with
# Emacs, please include in your email the contents of the *ftp ...*
# buffer for a failed session.
#
#
# -=- TODO -=-
#
# * rewrite in a real programming language
# * implement missing commands


package SquidFTP;


use Term::ReadLine;
use LWP::UserAgent;
use Text::ParseWords ();
use IO::File;
use IO::Handle;
use strict "vars";
use strict "refs";
use vars qw($ua $term %status);


sub main {
  my($prompt, $line);
  
  $ua = new LWP::UserAgent;
  $ua->env_proxy();
  $ua->agent("SquidFTP/0.1 ");
  $status{'pwd'} = '/';
  $status{'user'} = 'anonymous';
  $status{'passwd'} = 'anonftp@';
  $status{'type'} = 'a';
  $prompt = "ftp> ";
  $term = new Term::ReadLine 'SquidFTP client';
  while (1) {
    $line = $term->readline($prompt) or bye();
    &handleLine($line);
    $term->addhistory($line) if $line =~ /\S/;
   }
}

sub handleLine {
  my($line) = @_;
  my(@word, $command);

  @word = Text::ParseWords::shellwords($line);
  $command = shift @word;
  eval { SquidFTP->$command(@word) } if defined $command;
  warn "?Invalid command " . $@ if $@;
}

sub wash {
  my($data) = @_;
  my($washed, $line, $total, $re, $file);

  $re = "<A HREF=\"([^\"]+)\"><IMG.*ALT=\"\\[([A-Z]+)\\] ?\"></A> " .
    "<A HREF=.*\. \. ([a-zA-Z]+) +([0-9]+) +([0-9:]+) +([0-9]+)?k?.*\n";
  $washed = "";
  if ($data =~ m|HTML listing generated by Squid|) {
    $data = substr($data, index($data, "</H2>\n<PRE>"));
    $data = substr($data, 0, rindex($data, "<ADDRESS>"));
    $total = 0;
    while ($data =~ m|$re|g) {
      if ($2 eq "DIR") {
        $line = sprintf("drwxr-xr-x   1 root      root %10d ", 512);
        $file = $1;
      } elsif ($2 eq "LINK") {
        $line = sprintf("drwxr-xr-x   1 root      root %10d ", 512);
        $file = $1 . "/";
      } else {
        $line = sprintf("-r--r--r--   1 root      root %10d ",
                        defined $6 ? $6 * 1024: 1024);
        $file = $1;
      }
      $line .= sprintf("%3s %2d %5s %s", $3, $4, $5, $file);
      $washed .= $line . "\n";
      $total++;
    }
    $washed = "total $total\n$washed";
  } else {
    $washed = $data;
  }
  return $washed;
}

sub open {
  my($self) = shift;
  my(@arg) = @_;

  $status{'host'} = $arg[0];
  print "Connected to " . $arg[0] . "\n";
  print "220 " . $arg[0] . " FTP server (Squid-proxied) ready.\n";
}

sub user {
  my($self) = shift;
  my(@arg) = @_;

  $arg[0] =~ s/^"?(.*)"?$/$1/;
  $status{'user'} = $arg[0];
  print "331 Password please.\n";
  if (defined $arg[1]) {
    $arg[1] =~ s/^"?(.*)"?$/$1/;
    $status{'passwd'} = $arg[1];
  } else {
    $status{'passwd'} = $term->readline("Password: ");
  }
  print "230 OK buddy.\n";
}

sub ls {
  my($self) = shift;
  my(@arg) = @_;
  my($from, $to, $sink, $url, $request, $response);

  die "Not connected" unless defined $status{'host'};
  if (defined $arg[0]) {
    $from = $arg[0];
    if ($from =~ m|^-alF (.*)$|) {
      $from = $1;
    }
  } else {
    $from = $status{'pwd'};
  }
  if (defined $arg[1]) {
    $to = $arg[1];
    $sink = new IO::File("> $to") or die "Cannot open $to";
  } else {
    $sink = new IO::Handle;
    $sink->fdopen(STDOUT, "w") or die "Cannot open stdout";
  }
  $url = new URI;
  $url->scheme("ftp");
  $url->userinfo($status{'user'} . ":" . $status{'passwd'});
  $url->host($status{'host'});
  $url->path("$from;type=" . $status{'type'});
  $request = new HTTP::Request('GET', $url->as_string());
  $request->header(Accept => "text/html, */*;q=0.1");
  $response = $ua->request($request);
  print "200 PORT command successful.\n";
  print "150 Opening data connection for $from\n";
  if ($response->is_success) {    
    print $sink wash($response->content);
  } else {
    print "500 Error " . $response->status_line . "\n";
  }
  close($sink);
  print "226 Transfer complete.\n";
}

sub dir {
  my($self) = shift;
  my(@arg) = @_;
  my($from, $to, $sink, $url, $request, $response);

  die "Not connected" unless defined $status{'host'};
  if (defined $arg[0]) {
    $from = $arg[0];
  } else {
    $from = $status{'pwd'};
  }
  if (defined $arg[1]) {
    $to = $arg[1];
    $sink = new IO::File("> $to") or die "Cannot open $to";
  } else {
    $sink = new IO::Handle;
    $sink->fdopen(STDOUT, "w") or die "Cannot open stdout";
  }
  $url = new URI;
  $url->scheme("ftp");
  $url->userinfo($status{'user'} . ":" . $status{'passwd'});
  $url->host($status{'host'});
  $url->path("$from;type=" . $status{'type'});
  $request = new HTTP::Request('GET', $url->as_string());
  $request->header(Accept => "text/html, */*;q=0.1");
  $response = $ua->request($request);
  print "200 PORT command successful.\n";
  print "150 Opening data connection for $from\n";
  if ($response->is_success) {    
    print $sink wash($response->content);
  } else {
    print "500 Error " . $response->status_line . "\n";
  }
  close($sink);
  print "226 Transfer complete.\n";
}  

sub get {
  my($self) = shift;
  my(@arg) = @_;
  my($from, $to, $sink, $url, $request, $response);

  die "Not connected" unless defined $status{'host'};
  if (defined $arg[0]) {
    $from = $arg[0];
  } else {
    $from = $status{'pwd'};
  }
  if (defined $arg[1]) {
    $to = $arg[1];
    $sink = new IO::File("> $to") or die "Cannot open $to";
  } else {
    $sink = new IO::Handle;
    $sink->fdopen(STDOUT, "w") or die "Cannot open stdout";
  }
  $url = new URI;
  $url->scheme("ftp");
  $url->userinfo($status{'user'} . ":" . $status{'passwd'});
  $url->host($status{'host'});
  $url->path("$from;type=" . $status{'type'});
  $request = new HTTP::Request('GET', $url->as_string());
  $request->header(Accept => "text/html, */*;q=0.1");
  $response = $ua->request($request);
  print "200 PORT command successful.\n";
  print "150 Opening data connection for $from\n";
  if ($response->is_success) {    
    print $sink wash($response->content);
  } else {
    print "500 Error " . $response->status_line . "\n";
  }
  print "226 Transfer complete.\n";
}

sub hash {
  print "Hash mark printing on (1024 bytes/hash mark).\n";
}

sub pwd {
  my($self) = shift;
  my(@arg) = @_;

  print "257 \"" . $status{'pwd'} . "\" is current directory.\n";
}

sub cd {
  my($self) = shift;
  my(@arg) = @_;

  if (! defined $arg[0]) {
    $status{'pwd'} = "/";
  } elsif (substr($arg[0], 0, 1) eq "/") {
    $status{'pwd'} = $arg[0];
  } elsif ($status{'pwd'} eq "/") {
    $status{'pwd'} .= $arg[0];
  } else {
    $status{'pwd'} .= "/" . $arg[0];
  }
  print "250 CWD command successful.\n";
}

sub lcd {
  my($self) = shift;
  my(@arg) = @_;

  chdir $arg[0];
  print "Local directory now " . $arg[0] . "\n";
}

sub type {
  my($self) = shift;
  my(@arg) = @_;

  if ($arg[0] eq "ascii") {
    $status{'type'} = 'a';
    print "200 Type set to A.\n";
  } elsif ($arg[0] eq 'binary') {
    $status{'type'} = 'i';
    print "200 Type set to I.\n";
  } else {
    print $arg[0] . ": unknown mode\n";
  }
}

sub close {
  $status{'host'} = undef;
  $status{'type'} = 'a';
  $status{'pwd'} = "/";
  print "221 Goodbye.\n";
}

sub bye {
  print "221 Goodbye.\n";
  exit(0);
}


&main();
1;

# EOF