PageRenderTime 61ms CodeModel.GetById 31ms RepoModel.GetById 0ms app.codeStats 0ms

/tags/v2-68/mh/lib/site/LWP/Protocol/ftp.pm

#
Perl | 394 lines | 349 code | 26 blank | 19 comment | 10 complexity | d23a8d77627af66ceefa54a8d2d9f1cc MD5 | raw file
Possible License(s): GPL-2.0, LGPL-2.0, GPL-3.0
  1. #
  2. # $Id: ftp.pm 225 2002-05-28 13:07:53Z winter $
  3. # Implementation of the ftp protocol (RFC 959). We let the Net::FTP
  4. # package do all the dirty work.
  5. package LWP::Protocol::ftp;
  6. use Carp ();
  7. use HTTP::Status ();
  8. use HTTP::Negotiate ();
  9. use HTTP::Response ();
  10. use LWP::MediaTypes ();
  11. use File::Listing ();
  12. require LWP::Protocol;
  13. @ISA = qw(LWP::Protocol);
  14. use strict;
  15. eval {
  16. require Net::FTP;
  17. Net::FTP->require_version(2.00);
  18. };
  19. my $init_failed = $@;
  20. sub request
  21. {
  22. my($self, $request, $proxy, $arg, $size, $timeout) = @_;
  23. $size = 4096 unless $size;
  24. LWP::Debug::trace('()');
  25. # check proxy
  26. if (defined $proxy)
  27. {
  28. return HTTP::Response->new(&HTTP::Status::RC_BAD_REQUEST,
  29. 'You can not proxy through the ftp');
  30. }
  31. my $url = $request->url;
  32. if ($url->scheme ne 'ftp') {
  33. my $scheme = $url->scheme;
  34. return HTTP::Response->new(&HTTP::Status::RC_INTERNAL_SERVER_ERROR,
  35. "LWP::Protocol::ftp::request called for '$scheme'");
  36. }
  37. # check method
  38. my $method = $request->method;
  39. unless ($method eq 'GET' || $method eq 'HEAD' || $method eq 'PUT') {
  40. return HTTP::Response->new(&HTTP::Status::RC_BAD_REQUEST,
  41. 'Library does not allow method ' .
  42. "$method for 'ftp:' URLs");
  43. }
  44. if ($init_failed) {
  45. return HTTP::Response->new(&HTTP::Status::RC_INTERNAL_SERVER_ERROR,
  46. $init_failed);
  47. }
  48. my $host = $url->host;
  49. my $port = $url->port;
  50. my $user = $url->user;
  51. my $password = $url->password;
  52. # If a basic autorization header is present than we prefer these over
  53. # the username/password specified in the URL.
  54. {
  55. my($u,$p) = $request->authorization_basic;
  56. if (defined $u) {
  57. $user = $u;
  58. $password = $p;
  59. }
  60. }
  61. # We allow the account to be specified in the "Account" header
  62. my $acct = $request->header('Account');
  63. # try to make a connection
  64. my $ftp = Net::FTP->new($host, Port => $port);
  65. unless ($ftp) {
  66. $@ =~ s/^Net::FTP: //;
  67. return HTTP::Response->new(&HTTP::Status::RC_INTERNAL_SERVER_ERROR, $@);
  68. }
  69. # Create an initial response object
  70. my $response = HTTP::Response->new(&HTTP::Status::RC_OK,
  71. "Document follows");
  72. $response->request($request);
  73. my $mess = $ftp->message; # welcome message
  74. LWP::Debug::debug($mess);
  75. $mess =~ s|\n.*||s; # only first line left
  76. $mess =~ s|\s*ready\.?$||;
  77. # Make the version number more HTTP like
  78. $mess =~ s|\s*\(Version\s*|/| and $mess =~ s|\)$||;
  79. $response->header("Server", $mess);
  80. $ftp->timeout($timeout) if $timeout;
  81. LWP::Debug::debug("Logging in as $user (password $password)...");
  82. unless ($ftp->login($user, $password, $acct)) {
  83. # Unauthorized. Let's fake a RC_UNAUTHORIZED response
  84. my $res = HTTP::Response->new(&HTTP::Status::RC_UNAUTHORIZED,
  85. scalar($ftp->message));
  86. $res->header("WWW-Authenticate", qq(Basic Realm="FTP login"));
  87. return $res;
  88. }
  89. LWP::Debug::debug($ftp->message);
  90. # Get & fix the path
  91. my @path = grep { length } $url->path_segments;
  92. my $remote_file = pop(@path);
  93. $remote_file = '' unless defined $remote_file;
  94. # my $params = $url->params;
  95. # if (defined($params) && $params eq 'type=a') {
  96. # $ftp->ascii;
  97. # } else {
  98. $ftp->binary;
  99. # }
  100. for (@path) {
  101. LWP::Debug::debug("CWD $_");
  102. unless ($ftp->cwd($_)) {
  103. return HTTP::Response->new(&HTTP::Status::RC_NOT_FOUND,
  104. "Can't chdir to $_");
  105. }
  106. }
  107. if ($method eq 'GET' || $method eq 'HEAD') {
  108. LWP::Debug::debug("MDTM");
  109. if (my $mod_time = $ftp->mdtm($remote_file)) {
  110. $response->last_modified($mod_time);
  111. if (my $ims = $request->if_modified_since) {
  112. if ($mod_time <= $ims) {
  113. $response->code(&HTTP::Status::RC_NOT_MODIFIED);
  114. $response->message("Not modified");
  115. return $response;
  116. }
  117. }
  118. }
  119. my $data; # the data handle
  120. LWP::Debug::debug("retrieve file?");
  121. if (length($remote_file) and $data = $ftp->retr($remote_file)) {
  122. my($type, @enc) = LWP::MediaTypes::guess_media_type($remote_file);
  123. $response->header('Content-Type', $type) if $type;
  124. for (@enc) {
  125. $response->push_header('Content-Encoding', $_);
  126. }
  127. my $mess = $ftp->message;
  128. LWP::Debug::debug($mess);
  129. if ($mess =~ /\((\d+)\s+bytes\)/) {
  130. $response->header('Content-Length', "$1");
  131. }
  132. if ($method ne 'HEAD') {
  133. # Read data from server
  134. $response = $self->collect($arg, $response, sub {
  135. my $content = '';
  136. my $result = $data->read($content, $size);
  137. return \$content;
  138. } );
  139. }
  140. unless ($data->close) {
  141. # Something did not work too well
  142. if ($method ne 'HEAD') {
  143. $response->code(&HTTP::Status::RC_INTERNAL_SERVER_ERROR);
  144. $response->message("FTP close response: " . $ftp->code .
  145. " " . $ftp->message);
  146. }
  147. }
  148. } elsif (!length($remote_file) || $ftp->code == 550) {
  149. # 550 not a plain file, try to list instead
  150. if (length($remote_file) && !$ftp->cwd($remote_file)) {
  151. LWP::Debug::debug("chdir before listing failed");
  152. return HTTP::Response->new(&HTTP::Status::RC_NOT_FOUND,
  153. "File '$remote_file' not found");
  154. }
  155. # It should now be safe to try to list the directory
  156. LWP::Debug::debug("dir");
  157. my @lsl = $ftp->dir;
  158. # Try to figure out if the user want us to convert the
  159. # directory listing to HTML.
  160. my @variants =
  161. (
  162. ['html', 0.60, 'text/html' ],
  163. ['dir', 1.00, 'text/ftp-dir-listing' ]
  164. );
  165. #$HTTP::Negotiate::DEBUG=1;
  166. my $prefer = HTTP::Negotiate::choose(\@variants, $request);
  167. my $content = '';
  168. if (!defined($prefer)) {
  169. return HTTP::Response->new(&HTTP::Status::RC_NOT_ACCEPTABLE,
  170. "Neither HTML nor directory listing wanted");
  171. } elsif ($prefer eq 'html') {
  172. $response->header('Content-Type' => 'text/html');
  173. $content = "<HEAD><TITLE>File Listing</TITLE>\n";
  174. my $base = $request->url->clone;
  175. my $path = $base->epath;
  176. $base->epath("$path/") unless $path =~ m|/$|;
  177. $content .= qq(<BASE HREF="$base">\n</HEAD>\n);
  178. $content .= "<BODY>\n<UL>\n";
  179. for (File::Listing::parse_dir(\@lsl, 'GMT')) {
  180. my($name, $type, $size, $mtime, $mode) = @$_;
  181. $content .= qq( <LI> <a href="$name">$name</a>);
  182. $content .= " $size bytes" if $type eq 'f';
  183. $content .= "\n";
  184. }
  185. $content .= "</UL></body>\n";
  186. } else {
  187. $response->header('Content-Type', 'text/ftp-dir-listing');
  188. $content = join("\n", @lsl, '');
  189. }
  190. $response->header('Content-Length', length($content));
  191. if ($method ne 'HEAD') {
  192. $response = $self->collect_once($arg, $response, $content);
  193. }
  194. } else {
  195. my $res = HTTP::Response->new(&HTTP::Status::RC_BAD_REQUEST,
  196. "FTP return code " . $ftp->code);
  197. $res->content_type("text/plain");
  198. $res->content($ftp->message);
  199. return $res;
  200. }
  201. } elsif ($method eq 'PUT') {
  202. # method must be PUT
  203. unless (length($remote_file)) {
  204. return HTTP::Response->new(&HTTP::Status::RC_BAD_REQUEST,
  205. "Must have a file name to PUT to");
  206. }
  207. my $data;
  208. if ($data = $ftp->stor($remote_file)) {
  209. LWP::Debug::debug($ftp->message);
  210. LWP::Debug::debug("$data");
  211. my $content = $request->content;
  212. my $bytes = 0;
  213. if (defined $content) {
  214. if (ref($content) eq 'SCALAR') {
  215. $bytes = $data->write($$content, length($$content));
  216. } elsif (ref($content) eq 'CODE') {
  217. my($buf, $n);
  218. while (length($buf = &$content)) {
  219. $n = $data->write($buf, length($buf));
  220. last unless $n;
  221. $bytes += $n;
  222. }
  223. } elsif (!ref($content)) {
  224. if (defined $content && length($content)) {
  225. $bytes = $data->write($content, length($content));
  226. }
  227. } else {
  228. die "Bad content";
  229. }
  230. }
  231. $data->close;
  232. LWP::Debug::debug($ftp->message);
  233. $response->code(&HTTP::Status::RC_CREATED);
  234. $response->header('Content-Type', 'text/plain');
  235. $response->content("$bytes bytes stored as $remote_file on $host\n")
  236. } else {
  237. my $res = HTTP::Response->new(&HTTP::Status::RC_BAD_REQUEST,
  238. "FTP return code " . $ftp->code);
  239. $res->content_type("text/plain");
  240. $res->content($ftp->message);
  241. return $res;
  242. }
  243. } else {
  244. return HTTP::Response->new(&HTTP::Status::RC_BAD_REQUEST,
  245. "Illegal method $method");
  246. }
  247. $response;
  248. }
  249. 1;
  250. __END__
  251. # This is what RFC 1738 has to say about FTP access:
  252. # --------------------------------------------------
  253. #
  254. # 3.2. FTP
  255. #
  256. # The FTP URL scheme is used to designate files and directories on
  257. # Internet hosts accessible using the FTP protocol (RFC959).
  258. #
  259. # A FTP URL follow the syntax described in Section 3.1. If :<port> is
  260. # omitted, the port defaults to 21.
  261. #
  262. # 3.2.1. FTP Name and Password
  263. #
  264. # A user name and password may be supplied; they are used in the ftp
  265. # "USER" and "PASS" commands after first making the connection to the
  266. # FTP server. If no user name or password is supplied and one is
  267. # requested by the FTP server, the conventions for "anonymous" FTP are
  268. # to be used, as follows:
  269. #
  270. # The user name "anonymous" is supplied.
  271. #
  272. # The password is supplied as the Internet e-mail address
  273. # of the end user accessing the resource.
  274. #
  275. # If the URL supplies a user name but no password, and the remote
  276. # server requests a password, the program interpreting the FTP URL
  277. # should request one from the user.
  278. #
  279. # 3.2.2. FTP url-path
  280. #
  281. # The url-path of a FTP URL has the following syntax:
  282. #
  283. # <cwd1>/<cwd2>/.../<cwdN>/<name>;type=<typecode>
  284. #
  285. # Where <cwd1> through <cwdN> and <name> are (possibly encoded) strings
  286. # and <typecode> is one of the characters "a", "i", or "d". The part
  287. # ";type=<typecode>" may be omitted. The <cwdx> and <name> parts may be
  288. # empty. The whole url-path may be omitted, including the "/"
  289. # delimiting it from the prefix containing user, password, host, and
  290. # port.
  291. #
  292. # The url-path is interpreted as a series of FTP commands as follows:
  293. #
  294. # Each of the <cwd> elements is to be supplied, sequentially, as the
  295. # argument to a CWD (change working directory) command.
  296. #
  297. # If the typecode is "d", perform a NLST (name list) command with
  298. # <name> as the argument, and interpret the results as a file
  299. # directory listing.
  300. #
  301. # Otherwise, perform a TYPE command with <typecode> as the argument,
  302. # and then access the file whose name is <name> (for example, using
  303. # the RETR command.)
  304. #
  305. # Within a name or CWD component, the characters "/" and ";" are
  306. # reserved and must be encoded. The components are decoded prior to
  307. # their use in the FTP protocol. In particular, if the appropriate FTP
  308. # sequence to access a particular file requires supplying a string
  309. # containing a "/" as an argument to a CWD or RETR command, it is
  310. # necessary to encode each "/".
  311. #
  312. # For example, the URL <URL:ftp://myname@host.dom/%2Fetc/motd> is
  313. # interpreted by FTP-ing to "host.dom", logging in as "myname"
  314. # (prompting for a password if it is asked for), and then executing
  315. # "CWD /etc" and then "RETR motd". This has a different meaning from
  316. # <URL:ftp://myname@host.dom/etc/motd> which would "CWD etc" and then
  317. # "RETR motd"; the initial "CWD" might be executed relative to the
  318. # default directory for "myname". On the other hand,
  319. # <URL:ftp://myname@host.dom//etc/motd>, would "CWD " with a null
  320. # argument, then "CWD etc", and then "RETR motd".
  321. #
  322. # FTP URLs may also be used for other operations; for example, it is
  323. # possible to update a file on a remote file server, or infer
  324. # information about it from the directory listings. The mechanism for
  325. # doing so is not spelled out here.
  326. #
  327. # 3.2.3. FTP Typecode is Optional
  328. #
  329. # The entire ;type=<typecode> part of a FTP URL is optional. If it is
  330. # omitted, the client program interpreting the URL must guess the
  331. # appropriate mode to use. In general, the data content type of a file
  332. # can only be guessed from the name, e.g., from the suffix of the name;
  333. # the appropriate type code to be used for transfer of the file can
  334. # then be deduced from the data content of the file.
  335. #
  336. # 3.2.4 Hierarchy
  337. #
  338. # For some file systems, the "/" used to denote the hierarchical
  339. # structure of the URL corresponds to the delimiter used to construct a
  340. # file name hierarchy, and thus, the filename will look similar to the
  341. # URL path. This does NOT mean that the URL is a Unix filename.
  342. #
  343. # 3.2.5. Optimization
  344. #
  345. # Clients accessing resources via FTP may employ additional heuristics
  346. # to optimize the interaction. For some FTP servers, for example, it
  347. # may be reasonable to keep the control connection open while accessing
  348. # multiple URLs from the same server. However, there is no common
  349. # hierarchical model to the FTP protocol, so if a directory change
  350. # command has been given, it is impossible in general to deduce what
  351. # sequence should be given to navigate to another directory for a
  352. # second retrieval, if the paths are different. The only reliable
  353. # algorithm is to disconnect and reestablish the control connection.