src/Net.pl

   1 #
   2 #   Net.pl: FTP//HTTP helper
   3 #   Author: dms
   4 #  Version: v0.1 (20000309)
   5 #  Created: 20000309
   6 #
   7
   8 #use strict;
   9 use vars qw(%ftp);
  10
  11 # Usage: &ftpGet($host,$dir,$file,[$lfile]);
  12 sub ftpGet {
  13     my ($host,$dir,$file,$lfile) = @_;
  14     my $verbose_ftp     = 1;
  15
  16     return unless &loadPerlModule("Net::FTP");
  17
  18     &status("FTP: opening connection to $host.") if ($verbose_ftp);
  19     my $ftp = Net::FTP->new($host,
  20         'Timeout'       => 1*60,
  21 ###     'BlockSize'     => 1024,        # ???
  22     );
  23
  24     return if ($@);
  25
  26     # login.
  27     if ($ftp->login()) {
  28         &status("FTP: logged in successfully.") if ($verbose_ftp);
  29     } else {
  30         &status("FTP: login failed.");
  31         $ftp->quit();
  32         return 0;
  33     }
  34
  35     # change directories.
  36     if ($ftp->cwd($dir)) {
  37         &status("FTP: changed dirs to $dir.") if ($verbose_ftp);
  38     } else {
  39         &status("FTP: cwd dir ($dir) does not exist.");
  40         $ftp->quit();
  41         return 0;
  42     }
  43
  44     # get the size of the file.
  45     my ($size, $lsize);
  46     if ($size = $ftp->size($file)) {
  47         &status("FTP: file size is $size") if ($verbose_ftp);
  48         my $thisfile    = $file || $lfile;
  49
  50         if ( -f $thisfile) {
  51             $lsize      = -s $thisfile;
  52             if ($_ != $lsize) {
  53                 &status("FTP: local size is $lsize; downloading.") if ($verbose_ftp);
  54             } else {
  55                 &status("FTP: same size; skipping.");
  56                 system("touch $thisfile");      # lame hack.
  57                 $ftp->quit();
  58                 return 1;
  59             }
  60         }
  61     } else {
  62         &status("FTP: file does not exist.");
  63         $ftp->quit();
  64         return 0;
  65     }
  66
  67     my $start_time      = &timeget();
  68     if (defined $lfile) {
  69         &status("FTP: getting $file as $lfile.") if ($verbose_ftp);
  70         $ftp->get($file,$lfile);
  71     } else {
  72         &status("FTP: getting $file.") if ($verbose_ftp);
  73         $ftp->get($file);
  74     }
  75
  76     if (defined $lsize) {
  77         &DEBUG("FTP: locsize => '$lsize'.");
  78         if ($size != $lsize) {
  79             &WARN("FTP: downloaded file seems truncated. FIXME.");
  80         }
  81     }
  82
  83     my $delta_time      = &timedelta($start_time);
  84     if ($delta_time > 0 and $verbose_ftp) {
  85         &status(sprintf("FTP: %.02f sec to complete.", $delta_time));
  86         my ($rateunit,$rate) = ("B", $size / $delta_time);
  87         if ($rate > 1024) {
  88             $rate /= 1024;
  89             $rateunit = "kB";
  90         }
  91         &status(sprintf("FTP: %.01f ${rateunit}/sec.", $rate));
  92     }
  93
  94     $ftp->quit();
  95
  96     return 1;
  97 }
  98
  99 # Usage: &ftpList($host,$dir);
 100 sub ftpList {
 101     my ($host,$dir) = @_;
 102     my $verbose_ftp = 1;
 103
 104     return unless &loadPerlModule("Net::FTP");
 105
 106     &status("FTP: opening connection to $host.") if ($verbose_ftp);
 107     my $ftp = Net::FTP->new($host,'Timeout'=>60);
 108
 109     return if ($@);
 110
 111     # login.
 112     if ($ftp->login()) {
 113         &status("FTP: logged in successfully.") if ($verbose_ftp);
 114     } else {
 115         &status("FTP: login failed.");
 116         $ftp->quit();
 117         return;
 118     }
 119
 120     # change directories.
 121     if ($ftp->cwd($dir)) {
 122         &status("FTP: changed dirs to $dir.") if ($verbose_ftp);
 123     } else {
 124         &status("FTP: cwd dir ($dir) does not exist.");
 125         $ftp->quit();
 126         return;
 127     }
 128
 129     &status("FTP: doing ls.") if ($verbose_ftp);
 130     foreach ($ftp->dir()) {
 131         # modes d uid gid size month day time file.
 132         if (/^(\S+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+) (\S{3})\s+(\d+) \d+:\d+ (.*)$/) {
 133             # name = size.
 134             $ftp{$8} = $5;
 135         } else {
 136             &DEBUG("FTP: UNKNOWN  => '$_'.");
 137         }
 138     }
 139     &status("FTP: ls done. ". scalar(keys %ftp) ." entries.");
 140     $ftp->quit();
 141
 142     return %ftp;
 143 }
 144
 145 ### LWP.
 146 # Usage: &getURL($url, [$post]);
 147 sub getURL {
 148     my ($url,$post) = @_;
 149     my ($ua,$res,$req);
 150
 151     return unless &loadPerlModule("LWP::UserAgent");
 152
 153     $ua = new LWP::UserAgent;
 154     $ua->proxy('http', $param{'httpProxy'}) if &IsParam("httpProxy");
 155
 156     if (defined $post) {
 157         $req = new HTTP::Request('POST',$url);
 158         $req->content_type('application/x-www-form-urlencoded');
 159         $req->content($post);
 160     } else {
 161         $req = new HTTP::Request('GET',$url);
 162     }
 163
 164     &status("getURL: getting '$url'");
 165     my $time = time();
 166     $res = $ua->request($req);
 167     my $size = length($res->content);
 168     if ($size and time - $time) {
 169         my $rate = int( $size/1000/(time - $time) );
 170         &status("getURL: Done (took ".&Time2String(time - $time).", $rate k/sec)");
 171     }
 172
 173     # return NULL upon error.
 174     return unless ($res->is_success);
 175
 176     return(split '\n', $res->content);
 177 }
 178
 179 sub getURLAsFile {
 180     my ($url,$file) = @_;
 181     my ($ua,$res,$req);
 182
 183     return unless &loadPerlModule("LWP::Simple");
 184
 185 ### PROXY NOT SUPPORTED WITH SIMPLE?
 186 ###    $ua->proxy('http', $param{'httpProxy'}) if &IsParam("httpProxy");
 187     my $time    = time();
 188     &status("getURLAsFile: getting '$url' as '$file'");
 189     my $retval  = getstore($url, $file);
 190     my $delta_time      = time() - $time;
 191     if ($delta_time) {
 192         my $size = -s $file || 0;
 193         my $rate = int($size / $delta_time / 1024);
 194         &status("getURLAsFile: Done. ($rate kB/sec)");
 195     }
 196
 197     return $retval;
 198 }
 199
 200 1;