--- toast 2004/02/05 00:04:15 1.290
+++ toast 2004/02/05 07:32:24 1.291
@@ -233,7 +233,8 @@
"postarmprog" => superuser ? "/sbin/ldconfig" : "",
"editprog" => "",
"defaultcmd" => "help",
- "httpproxy" => $ENV{http_proxy} || "",
+ "httpproxy" => exists($ENV{http_proxy}) ? $ENV{http_proxy} : "",
+ "ftpproxy" => exists($ENV{ftp_proxy}) ? $ENV{ftp_proxy} : "",
"quiet" => false,
"autofind" => true,
"autochange" => true,
@@ -753,30 +754,41 @@
$_;
}
-sub openhttp(*$;$)
+sub tcpconnect(*$$;$)
{
local(*HANDLE) = shift;
- my($url, $method) = @_;
+ my($host, $port, $ip) = @_;
+ $ip = gethostbyname($host) || error("gethostbyname $host: $!")
+ unless defined($ip);
+ socket(HANDLE, 2, 1, 0) || error("$!");
+ binmode(HANDLE) || error("binmode: $!"); # perl 5.8.0 utf8 bug
+ connect(HANDLE, pack("Sna4x8", 2, $port, $ip)) ||
+ error("connect $host:$port: $!");
+ unbuffer(HANDLE);
+ return $ip;
+}
+
+sub openhttp(*$;$;$)
+{
+ local(*HANDLE) = shift;
+ my($url, $method, $proxy) = @_;
$method ||= "GET";
- $url =~ m!^http://([\w\.]+)(:(\d+))?(/[\!-\~]*)?$! || error("bad url: $url");
+ $proxy = httpproxy unless defined($proxy);
explain("fetching $url");
- my($host, $port, $path) = ($1, $3 || 80, $4 || '/');
+ $url =~ m!^(\w+)://([\w\.]+)(:(\d+))?(/[\!-\~]*)?$! || error("bad url: $url");
+ my($proto, $host, $port, $path) = ($1, $2, $4 || 80, $5 || '/');
my($hdrhost) = $port == 80 ? $host : "$host:$port";
- if(httpproxy)
+ if($proxy)
{
- $path = "http://$host:$port$path";
- httpproxy =~ m!^(http://)?([\w\.]+)(:(\d+))?([^:]+)(:(\d+))?/?$!
- || error("bad httpproxy: " . httpproxy);
+ $path = "$proto://$host:$port$path";
+ $proxy =~ m!^(\w+://)?([\w\.]+)(:(\d+))?([^:]+)(:(\d+))?/?$!
+ || error("bad proxy URL: $proxy");
($host, $port) = ($2, $4 || 8080);
}
- my($ip) = gethostbyname($host) || error("gethostbyname $host: $!");
my($uagent) = "$myname/$myversion ($^O; $myurl)";
my($request) = "$method $path HTTP/1.0\r\nHost: $hdrhost\r\n".
"User-Agent: $uagent\r\nAccept: */*\r\n\r\n";
- socket(HANDLE, 2, 1, 0) || error("$!");
- connect(HANDLE, pack("Sna4x8", 2, $port, $ip)) ||
- error("connect $host:$port: $!");
- unbuffer(HANDLE);
+ tcpconnect(*HANDLE, $host, $port);
print HANDLE $request || error("write to $host:$port: $!");
}
@@ -790,12 +802,11 @@
return $result;
}
-sub openhttpurl(*$)
+sub openhttpurl(*$;$)
{
local(*HANDLE) = shift;
- my($url) = @_;
- return true if openprog(*HANDLE, "GET", $url);
- openhttp(*HANDLE, $url);
+ my($url, $proxy) = @_;
+ openhttp(*HANDLE, $url, undef, $proxy);
local($_);
$_ = <HANDLE>;
s/\r?\n?$//;
@@ -804,6 +815,73 @@
return true;
}
+sub ftpcmd(*$;$)
+{
+ local(*CTRL, $_) = shift;
+ my($cmd, $expected) = @_;
+ print CTRL "$cmd\r\n" || error("error sending ftp command: $!") if $cmd;
+ while(<CTRL>)
+ {
+ s/[\r\n]+$//;
+ if(/^(\d{3}) /)
+ {
+ my($response) = $1;
+ error("ftp server: $_") if defined($expected) && $response != $expected;
+ return $_;
+ }
+ }
+ error("lost ftp control connection") unless $cmd =~ /QUIT/;
+}
+
+sub openftpurl(*$)
+{
+ local(*HANDLE) = shift;
+ my($url) = @_;
+ return openhttpurl(*HANDLE, $url, ftpproxy) if ftpproxy;
+
+ explain("fetching $url");
+ $url =~ m!^(\w+)://([\w\.]+)(:(\d+))?(/[\!-\~]*)?$! || error("bad url: $url");
+ my($proto, $host, $port, $path) = ($1, $2, $4 || 21, $5 || '/');
+ error("don't know how to fetch FTP directory listings") if $path =~ m!/$!;
+
+ local(*CTRL, *DATA);
+ my($ip) = tcpconnect(*CTRL, $host, $port);
+ ftpcmd(*CTRL, undef, 220);
+ ftpcmd(*CTRL, "USER anonymous", 230);
+ ftpcmd(*CTRL, "TYPE I");
+ my($size) = ftpcmd(*CTRL, "SIZE $path", 213);
+ $size =~ /^\d+\s+(\d+)/ or die("bad SIZE response: $size");
+ $size = $1;
+ my($pasv) = ftpcmd(*CTRL, "PASV", 227);
+ $pasv =~ /(\d+)\s*,\s*(\d+)\s*\)/ || error("bad PASV response: $pasv");
+ my($dataport) = $1*256 + $2;
+ tcpconnect(*DATA, $host, $dataport, $ip);
+ my($retr) = ftpcmd(*CTRL, "RETR $path");
+ $retr =~ /^(\d+) / && $1 <= 150 || error("ftp RETR error: $retr");
+ my($pid) = open(HANDLE, "-|");
+ error("fork: $!") unless defined($pid);
+ if($pid)
+ {
+ close(CTRL) || error("close ftp control: $!");
+ close(DATA) || error("close ftp data: $!");
+ return true;
+ }
+
+ binmode(STDOUT) || error("binmode stdout: $!"); # perl 5.8.0 utf8 bug
+ my($buf) = 0;
+ while(sysread(DATA, $buf = "", min(8192, $size), 0))
+ {
+ print($buf) || error("write stdout: $!");
+ $size -= length($buf);
+ }
+ error("lost ftp data connection") if $size;
+ close(DATA) || error("close ftp data: $!");
+ ftpcmd(*CTRL, undef, 226);
+ ftpcmd(*CTRL, "QUIT");
+ exit(0);
+ error;
+}
+
sub openfileurl(*$)
{
local(*HANDLE) = shift;
@@ -829,13 +907,6 @@
openprog(*HANDLE, "ssh", $userhost, "cat", $path);
}
-sub openwgeturl(*$)
-{
- local(*HANDLE) = shift;
- my($url) = @_;
- openprog(*HANDLE, "wget", "-O-", $url);
-}
-
sub openurl(*$)
{
local(*HANDLE) = shift;
@@ -844,10 +915,14 @@
my($proto) = lc($1);
local($ENV{http_proxy}) = httpproxy if httpproxy;
+ local($ENV{ftp_proxy}) = ftpproxy if ftpproxy;
+
$proto eq "file" && openfileurl(*HANDLE, $url) ||
$proto eq "ssh" && opensshurl (*HANDLE, $url) ||
- openwgeturl(*HANDLE, $url) ||
+ openprog(*HANDLE, "wget", "-O-", $url) ||
+ openprog(*HANDLE, "GET", $url) ||
$proto eq "http" && openhttpurl(*HANDLE, $url) ||
+ $proto eq "ftp" && openftpurl(*HANDLE, $url) ||
error("unable to download: $url");
}
@@ -3259,6 +3334,7 @@
}
);
error if @dirmodes;
+ true;
} @_;
postarm;
@@ -4971,13 +5047,14 @@
commands will be able to operate on the package without downloading
any additional files from the network. If a given package is already
C<stored>, the existing downloaded files are silently preserved; use
-B<toast purge> to force them to be downloaded afresh. B<toast get> has
-rudimentary built-in support for C<file> and C<http> URLs. If GNU B<wget>
+B<toast purge> to force them to be downloaded afresh. If GNU B<wget>
is installed, B<toast get> will use it to fetch C<http>, C<https>, and
C<ftp> URLs; otherwise, if LWP is installed, B<toast get> will use the
-B<GET> utility to fetch C<http> URLs, rather than using built-in HTTP.
+B<GET> utility to fetch those types of URLs; otherwise B<toast get>
+will try to fetch C<http> and C<ftp> URLs itself using rudimentary
+built-in routines. B<toast get> always handles C<file> URLs itself.
If B<ssh> is available, B<toast get> can use it to fetch (non-standard)
-URLs of the form C<ssh:/[username@]hostname/absolute/path/to/file>.
+URLs of the form C<ssh://[username@]hostname/absolute/path/to/file>.
=item S<B<toast build> [ I<PACKAGE> ...]>
@@ -5302,13 +5379,21 @@
proxy server for C<http> and C<https> URLs. When using B<wget> or
B<GET>, the given URL will be exported in the C<http_proxy> environment
variable without further checking if non-empty. When using built-in
-HTTP, the proxy URL should be of the form C<I<hostname>:I<port>>
-or C<http://I<hostname>:I<port>/>. Note that using an empty URL will
-not cause C<http_proxy> to be removed from the environment of B<wget>
-or B<GET>. The proxy string is not exported during B<toast build>.
-Default: the current value of the C<http_proxy> environment variable,
-or the empty string if that variable is not set.
+HTTP, the proxy URL should be of the form C<I<hostname>:I<port>> or
+C<http://I<hostname>:I<port>/>; other forms may also work. Note that
+using an empty URL will not cause C<http_proxy> to be removed from the
+environment of B<wget> or B<GET>. The proxy string is not exported
+during B<toast build>. Default: the current value of the C<http_proxy>
+environment variable, or the empty string if that variable is not set.
+=item B<--ftpproxy=>I<URL>
+
+The B<ftpproxy> option is just like the B<httpproxy> option, but applies
+to C<ftp> URLs. Note that this really refers to an FTP-to-HTTP gateway,
+rather than a true FTP proxy server. Default: the current value of the
+B<ftp_proxy> environment variable, or the empty string if that variable
+is not set.
+
=item S<B<--quiet> | B<--noquiet>>
When B<quiet> is enabled, most commands will produce output only on
@@ -5636,7 +5721,6 @@
- find a way to rebuild indices for apropos by default
- fold archives by URL and/or hash?
- zsh completions!
- - built-in FTP?
Questions left unanswered by this documentation: