home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1994 March / Source_Code_CD-ROM_Walnut_Creek_March_1994.iso / compsrcs / misc / volume37 / ftpmail / part01 < prev    next >
Encoding:
Text File  |  1993-05-15  |  56.6 KB  |  2,367 lines
  1. Newsgroups: comp.sources.misc
  2. From: lmjm@doc.ic.ac.uk (Lee M J McLoughlin)
  3. Subject: v37i051:  ftpmail - Automatic Email to FTP Gateway, v1.13, Part01/02
  4. Message-ID: <csm-v37i051=ftpmail.142201@sparky.IMD.Sterling.COM>
  5. X-Md4-Signature: 4ecc925e3f77fe79f85f72c774ea304e
  6. Date: Tue, 11 May 1993 19:26:09 GMT
  7. Approved: kent@sparky.imd.sterling.com
  8.  
  9. Submitted-by: lmjm@doc.ic.ac.uk (Lee M J McLoughlin)
  10. Posting-number: Volume 37, Issue 51
  11. Archive-name: ftpmail/part01
  12. Environment: UNIX, Perl, Sun, Dec, INET
  13.  
  14. Ftpmail is an email->ftp gateway.  You mail requests to a user (eg:
  15. ftpmail).  This causes q.pl to be called which checks the request and
  16. sticks it in a queue.  dq.pl then parses the queue and does the ftp
  17. transfers that the job specifies mailing back the files that were
  18. transfers.  As various things happen notes are writen in the
  19. ftpmail log file.  
  20.  
  21. It is all writen in perl and sends responses using either mail or by
  22. directly calling sendmail.  When using sendmail MIME support is
  23. available.
  24.  
  25. If a transfer fails for a fatal reason then it is dequed and the user
  26. is emailed.  If it fails for a non-fatal reason (such as timeout on
  27. connect) then it will be requeued to try later (the next time dq.pl is
  28. called).  Once a transfer (get|dir|ls) has succeeded it is marked as
  29. DONE and will be skipped.  All other commands will still be obeyed.  A
  30. job will only be tried for a fix number of times, then rejected.
  31.  
  32. For user level details read the help file.
  33.  
  34. If the file motd is present then its contents are inserted at
  35. the start of any responses.
  36.  
  37.  ARCHIVES
  38.  --------
  39.  
  40. This package is available from:
  41.     src.doc.ic.ac.uk:packages/ftpmail/
  42.     grasp1.univ-lyon1.fr:pub/unix/mail/tools/ftpmail/
  43.     ftp.sterling.com:mail/ftpmail
  44.     
  45.  TO INSTALL
  46.  ----------
  47.  
  48. Create an account called 'ftpmail', the home directory of ftpmail is
  49. where all the scripts will be installed and subdirectories of it form
  50. the queues.
  51.  
  52. Edit config.pl to reflect your local details.  (If you
  53. change the default site also edit help.)  The auth file is
  54. just a series of regexps, so a line of just dot would allow all email
  55. addresses to use ftpmail.
  56.  
  57. Once you have edited the above files run inst.pl.  inst.pl
  58. will create the ftpmail directories based on values in
  59. config.pl and copy in various files.  Its a bit of a
  60. hack.
  61.  
  62. At src.doc.ic.ac.uk I only allow requests to be submitted via email.
  63. The ftpmail account is not present on any general machine, just on the
  64. main mail gateway .  On that I use the PP .mailfilter script mechanism
  65. to cause any mail delivered to that ftpmail to invoke q.pl. But
  66. anything that causes q.pl to be run on the input request will do.
  67. Under sendmail create ~ftpmail/.forward containing:
  68. "|/src.doc.ic.ac.uk/public/ic.doc/ftpmail/q.pl"
  69. (Or similar.)
  70.  
  71. The file crontab contains a suggested cron entry that should be run as
  72. the user  ftpmail.  This calls dq.pl that dequeues the entries and
  73. runs them.  dq.pl should run forever once started.  But as I am a
  74. paranoid person I call it every half hour just to be safe.
  75.  
  76. Note that mail sent is sent by ftpmail not ftpmail-request.  ftpmail
  77. does other tricks to prevent mail loops forming.  I tried running with
  78. mail being sent by ftpmail-request and ftpmail-request aliases to me.
  79. I found that most of the traffic to ftpmail-request is from people who
  80. submit jobs by replying to ftpmail responses in order to submit new
  81. jobs.
  82.  
  83.  THANKS
  84.  ------
  85. Thanks to all those who suggested improvements.  Also special thanks
  86. to Christophe.Wolfhugel@hsc-sec.fr for all his work on mime
  87. and the new queing system which formed the basis for some of the new code.
  88.  
  89.  WORKERS
  90.  -------
  91. If you want to help develope ftpmail then there is now a mailing list:
  92.     ftpmail-workers@doc.ic.ac.uk
  93. To subscribe email to:    ftpmail-workers-request@doc.ic.ac.uk
  94. a message like:
  95.     Subject: add me
  96.     
  97.     subscribe ftpmail-workers Your Full Name Here
  98.  
  99.  COPYRIGHT
  100.  ---------
  101. Writen by Lee McLoughlin <lmjm@doc.ic.ac.uk>
  102.  
  103. You can do what you like with this except claim that you wrote it or
  104. give copies with changes not approved by Lee.  Neither Lee nor any other
  105. organisation can be held liable for any problems caused by the use or
  106. storage of this package.
  107. ---
  108. #! /bin/sh
  109. # This is a shell archive.  Remove anything before this line, then feed it
  110. # into a shell via "sh file" or similar.  To overwrite existing files,
  111. # type "sh file -c".
  112. # Contents:  README ftp.pl help_english q.pl
  113. # Wrapped by kent@sparky on Tue May 11 12:58:17 1993
  114. PATH=/bin:/usr/bin:/usr/ucb:/usr/local/bin:/usr/lbin ; export PATH
  115. echo If this archive is complete, you will see the following message:
  116. echo '          "shar: End of archive 1 (of 2)."'
  117. if test -f 'README' -a "${1}" != "-c" ; then 
  118.   echo shar: Will not clobber existing file \"'README'\"
  119. else
  120.   echo shar: Extracting \"'README'\" \(3607 characters\)
  121.   sed "s/^X//" >'README' <<'END_OF_FILE'
  122. XFtpmail is an email->ftp gateway.  You mail requests to a user (eg:
  123. Xftpmail).  This causes q.pl to be called which checks the request and
  124. Xsticks it in a queue.  dq.pl then parses the queue and does the ftp
  125. Xtransfers that the job specifies mailing back the files that were
  126. Xtransfers.  As various things happen notes are writen in the
  127. Xftpmail log file.  
  128. X
  129. XIt is all writen in perl and sends responses using either mail or by
  130. Xdirectly calling sendmail.  When using sendmail MIME support is
  131. Xavailable.
  132. X
  133. XIf a transfer fails for a fatal reason then it is dequed and the user
  134. Xis emailed.  If it fails for a non-fatal reason (such as timeout on
  135. Xconnect) then it will be requeued to try later (the next time dq.pl is
  136. Xcalled).  Once a transfer (get|dir|ls) has succeeded it is marked as
  137. XDONE and will be skipped.  All other commands will still be obeyed.  A
  138. Xjob will only be tried for a fix number of times, then rejected.
  139. X
  140. XFor user level details read the help file.
  141. X
  142. XIf the file motd is present then its contents are inserted at
  143. Xthe start of any responses.
  144. X
  145. XARCHIVES
  146. X--------
  147. XThis packages is available from:
  148. X    src.doc.ic.ac.uk:packages/ftpmail/
  149. X    grasp1.univ-lyon1.fr:pub/unix/mail/tools/ftpmail/
  150. X
  151. X
  152. XTO INSTALL
  153. X----------
  154. X
  155. XCreate an account called 'ftpmail', the home directory of ftpmail is
  156. Xwhere all the scripts will be installed and subdirectories of it form
  157. Xthe queues.
  158. X
  159. XEdit config.pl to reflect your local details.  (If you
  160. Xchange the default site also edit help.)  The auth file is
  161. Xjust a series of regexps, so a line of just dot would allow all email
  162. Xaddresses to use ftpmail.
  163. X
  164. XOnce you have edited the above files run inst.pl.  inst.pl
  165. Xwill create the ftpmail directories based on values in
  166. Xconfig.pl and copy in various files.  Its a bit of a
  167. Xhack.
  168. X
  169. XAt src.doc.ic.ac.uk I only allow requests to be submitted via email.
  170. XThe ftpmail account is not present on any general machine, just on the
  171. Xmain mail gateway .  On that I use the PP .mailfilter script mechanism
  172. Xto cause any mail delivered to that ftpmail to invoke q.pl. But
  173. Xanything that causes q.pl to be run on the input request will do.
  174. XUnder sendmail create ~ftpmail/.forward containing:
  175. X"|/src.doc.ic.ac.uk/public/ic.doc/ftpmail/q.pl"
  176. X(Or similar.)
  177. X
  178. XThe file crontab contains a suggested cron entry that should be run as
  179. Xthe user  ftpmail.  This calls dq.pl that dequeues the entries and
  180. Xruns them.  dq.pl should run forever once started.  But as I am a
  181. Xparanoid person I call it every half hour just to be safe.
  182. X
  183. XNote that mail sent is sent by ftpmail not ftpmail-request.  ftpmail
  184. Xdoes other tricks to prevent mail loops forming.  I tried running with
  185. Xmail being sent by ftpmail-request and ftpmail-request aliases to me.
  186. XI found that most of the traffic to ftpmail-request is from people who
  187. Xsubmit jobs by replying to ftpmail responses in order to submit new
  188. Xjobs.
  189. X
  190. XTHANKS
  191. X------
  192. XThanks to all those who suggested improvements.  Also special thanks
  193. Xto Christophe.Wolfhugel@hsc-sec.fr for all his work on mime
  194. Xand the new queing system which formed the basis for some of the new code.
  195. X
  196. XWORKERS
  197. X-------
  198. XIf you want to help develope ftpmail then there is now a mailing list:
  199. X    ftpmail-workers@doc.ic.ac.uk
  200. XTo subscribe email to:    ftpmail-workers-request@doc.ic.ac.uk
  201. Xa message like:
  202. X    Subject: add me
  203. X    
  204. X    subscribe ftpmail-workers Your Full Name Here
  205. X
  206. XCOPYRIGHT
  207. X---------
  208. XWriten by Lee McLoughlin <lmjm@doc.ic.ac.uk>
  209. X
  210. XYou can do what you like with this except claim that you wrote it or
  211. Xgive copies with changes not approved by Lee.  Neither Lee nor any other
  212. Xorganisation can be held liable for any problems caused by the use or
  213. Xstorage of this package.
  214. END_OF_FILE
  215.   if test 3607 -ne `wc -c <'README'`; then
  216.     echo shar: \"'README'\" unpacked with wrong size!
  217.   fi
  218.   # end of 'README'
  219. fi
  220. if test -f 'ftp.pl' -a "${1}" != "-c" ; then 
  221.   echo shar: Will not clobber existing file \"'ftp.pl'\"
  222. else
  223.   echo shar: Extracting \"'ftp.pl'\" \(28699 characters\)
  224.   sed "s/^X//" >'ftp.pl' <<'END_OF_FILE'
  225. X#-*-perl-*-
  226. X# This is a wrapper to the chat2.pl routines that make life easier
  227. X# to do ftp type work.
  228. X# Mostly by Lee McLoughlin <lmjm@doc.ic.ac.uk>
  229. X# based on original version by Alan R. Martello <al@ee.pitt.edu>
  230. X# And by A.Macpherson@bnr.co.uk for multi-homed hosts
  231. X#
  232. X# Basic usage:
  233. X#  $ftp_port = 21;
  234. X#  $retry_call = 1;
  235. X#  $attempts = 2;
  236. X#  if( &ftp'open( $site, $ftp_port, $retry_call, $attempts ) != 1 ){
  237. X#   die "failed to open ftp connection";
  238. X#  }
  239. X#  if( ! &ftp'login( $user, $pass ) ){
  240. X#   die "failed to login";
  241. X#  }
  242. X#  &ftp'type( $text_mode ? 'A' : 'I' );
  243. X#  if( ! &ftp'get( $remote_filename, $local_filename, 0 ) ){
  244. X#   die "failed to get file;
  245. X#  }
  246. X#  &ftp'quit();
  247. X#
  248. X#
  249. X# $Header: /a/swan/home/swan/staff/csg/lmjm/src/perl/mirror/RCS/ftp.pl,v 1.25 1993/05/07 23:36:07 lmjm Exp lmjm $
  250. X# $Log: ftp.pl,v $
  251. X# Revision 1.25  1993/05/07  23:36:07  lmjm
  252. X# Corrected typo in expect code causing long continuations to fail.
  253. X# Timeouts are no longer a fatal error.
  254. X# Improved the balance in the timeouts.
  255. X#
  256. X# Revision 1.24  1993/05/06  23:13:29  lmjm
  257. X# Major cleanup.
  258. X# Reset ALRM when done.
  259. X# Try to reset if cannot write local file on get.
  260. X# Spot unreadable remote files.
  261. X# Cleaned up *MAJOR* dumb code in open_data_socket.
  262. X#
  263. X# Revision 1.23  1993/05/06  21:14:19  lmjm
  264. X# Use the new mapin.
  265. X# Correct put code.
  266. X#
  267. X# Revision 1.22  1993/04/29  23:31:26  lmjm
  268. X# Added sample prog as a comment.
  269. X# Clear out chat string that may be large.
  270. X# Moved some declarations out of loops and used packageless functin names to
  271. X# save space.
  272. X#
  273. X# Revision 1.21  1993/04/28  20:45:26  lmjm
  274. X# Made the RETR/STOR commands report the file.
  275. X#
  276. X# Revision 1.20  1993/04/27  19:53:49  lmjm
  277. X# Allow for filename mapping before Xfer.  Useful for VMS -> unix.
  278. X#
  279. X# Revision 1.19  1993/04/26  19:58:33  lmjm
  280. X# Added missing trailing ; - for older perl's
  281. X#
  282. X# Revision 1.18  1993/04/25  13:15:43  lmjm
  283. X# Keep track of wether the service is open and avoid writing to dead sockets.
  284. X# Added SIGPIPE handler if ftp'set_signals called.
  285. X# Added a version var.
  286. X#
  287. X# Revision 1.17  1993/04/21  10:06:54  lmjm
  288. X# Send all status reports to STDERR not to STDOUT (to allow use by ftpcat).
  289. X# Allow target file to be '-' meaning STDOUT
  290. X# Added ftp'quote
  291. X#
  292. X# Revision 1.16  1993/01/28  18:59:05  lmjm
  293. X# Allow socket arguemtns to come from main.
  294. X# Minor cleanups - removed old comments.
  295. X#
  296. X# Revision 1.15  1992/11/25  21:09:30  lmjm
  297. X# Added another REST return code.
  298. X#
  299. X# Revision 1.14  1992/08/12  14:33:42  lmjm
  300. X# Fail ftp'write if out of space.
  301. X#
  302. X# Revision 1.13  1992/03/20  21:01:03  lmjm
  303. X# Added in the proxy ftp code from Edwards Reed <err@cinops.xerox.com>
  304. X# Added  ftp'delete from Aaron Wohl <aw0g+@andrew.cmu.edu>
  305. X#
  306. X# Revision 1.12  1992/02/06  23:25:56  lmjm
  307. X# Moved code around so can use this as a lib for both mirror and ftpmail.
  308. X# Time out opens.  In case Unix doesn't bother to.
  309. X#
  310. X# Revision 1.11  1991/11/27  22:05:57  lmjm
  311. X# Match the response code number at the start of a line allowing
  312. X# for any leading junk.
  313. X#
  314. X# Revision 1.10  1991/10/23  22:42:20  lmjm
  315. X# Added better timeout code.
  316. X# Tried to optimise file transfer
  317. X# Moved open/close code to not leak file handles.
  318. X# Cleaned up the alarm code.
  319. X# Added $fatalerror to show wether the ftp link is really dead.
  320. X#
  321. X# Revision 1.9  1991/10/07  18:30:35  lmjm
  322. X# Made the timeout-read code work.
  323. X# Added restarting file gets.
  324. X# Be more verbose if ever have to call die.
  325. X#
  326. X# Revision 1.8  1991/09/17  22:53:16  lmjm
  327. X# Spot when open_data_socket fails and return a failure rather than dying.
  328. X#
  329. X# Revision 1.7  1991/09/12  22:40:25  lmjm
  330. X# Added Andrew Macpherson's patches for hosts without ip forwarding.
  331. X#
  332. X# Revision 1.6  1991/09/06  19:53:52  lmjm
  333. X# Relaid out the code the way I like it!
  334. X# Changed the debuggin to produce more "appropriate" messages
  335. X# Fixed bugs in the ordering of put and dir listing.
  336. X# Allow for hash printing when getting files (a la ftp).
  337. X# Added the new commands from Al.
  338. X# Don't print passwords in debugging.
  339. X#
  340. X# Revision 1.5  1991/08/29  16:23:49  lmjm
  341. X# Timeout reads from the remote ftp server.
  342. X# No longer call die expect on fatal errors.  Just return fail codes.
  343. X# Changed returns so higher up routines can tell whats happening.
  344. X# Get expect/accept in correct order for dir listing.
  345. X# When ftp_show is set then print hashes every 1k transfered (like ftp).
  346. X# Allow for stripping returns out of incoming data.
  347. X# Save last error in a global string.
  348. X#
  349. X# Revision 1.4  1991/08/14  21:04:58  lmjm
  350. X# ftp'get now copes with ungetable files.
  351. X# ftp'expect code changed such that the string_to_print is
  352. X# ignored and the string sent back from the remote system is printed
  353. X# instead.
  354. X# Implemented patches from al.  Removed spuiours tracing statements.
  355. X#
  356. X# Revision 1.3  1991/08/09  21:32:18  lmjm
  357. X# Allow for another ok code on cwd's
  358. X# Rejigger the log levels
  359. X# Send \r\n for some odd ftp daemons
  360. X#
  361. X# Revision 1.2  1991/08/09  18:07:37  lmjm
  362. X# Don't print messages unless ftp_show says to.
  363. X#
  364. X# Revision 1.1  1991/08/08  20:31:00  lmjm
  365. X# Initial revision
  366. X#
  367. X
  368. Xrequire 'chat2.pl';
  369. Xrequire 'socket.ph';
  370. X
  371. X
  372. Xpackage ftp;
  373. X
  374. Xif( defined( &main'PF_INET ) ){
  375. X    $pf_inet = &main'PF_INET;
  376. X    $sock_stream = &main'SOCK_STREAM;
  377. X    local($name, $aliases, $proto) = getprotobyname( 'tcp' );
  378. X    $tcp_proto = $proto;
  379. X}
  380. Xelse {
  381. X    # XXX hardwired $PF_INET, $SOCK_STREAM, 'tcp'
  382. X    # but who the heck would change these anyway? (:-)
  383. X    $pf_inet = 2;
  384. X    $sock_stream = 1;
  385. X    $tcp_proto = 6;
  386. X}
  387. X
  388. X# If the remote ftp daemon doesn't respond within this time presume its dead
  389. X# or something.
  390. X$timeout = 100;
  391. X
  392. X# Timeout a read if I don't get data back within this many seconds
  393. X$timeout_read = 2 * $timeout;
  394. X
  395. X# Timeout an open
  396. X$timeout_open = $timeout;
  397. X
  398. X$ftp'version = '$Revision: 1.25 $';
  399. X
  400. X# This is a "global" it contains the last response from the remote ftp server
  401. X# for use in error messages
  402. X$ftp'response = "";
  403. X# Also ftp'NS is the socket containing the data coming in from the remote ls
  404. X# command.
  405. X
  406. X# The size of block to be read or written when talking to the remote
  407. X# ftp server
  408. X$ftp'ftpbufsize = 4096;
  409. X
  410. X# How often to print a hash out, when debugging
  411. X$ftp'hashevery = 1024;
  412. X# Output a newline after this many hashes to prevent outputing very long lines
  413. X$ftp'hashnl = 70;
  414. X
  415. X# Is there a connection open?
  416. X$ftp'service_open = 0;
  417. X
  418. X# If a proxy connection then who am I really talking to?
  419. X$real_site = "";
  420. X
  421. X# Where error/log reports are sent to
  422. X$ftp'showfd = 'STDERR';
  423. X
  424. X# Name of a function to call on a pathname to map it into a remote
  425. X# pathname.
  426. X$ftp'mapunixout = '';
  427. X$ftp'manunixin = '';
  428. X
  429. X# This is just a tracing aid.
  430. X$ftp_show = 0;
  431. X
  432. Xsub ftp'debug
  433. X{
  434. X    $ftp_show = @_[0];
  435. X#    if( $ftp_show ){
  436. X#        print $ftp'showfd "ftp debugging on\n";
  437. X#    }
  438. X}
  439. X
  440. Xsub ftp'set_timeout
  441. X{
  442. X    local( $to ) = @_;
  443. X    return if $to == $timeout;
  444. X    $timeout = $to;
  445. X    $timeout_open = $timeout;
  446. X    $timeout_read = 2 * $timeout;
  447. X    if( $ftp_show ){
  448. X        print $ftp'showfd "ftp timeout set to $timeout\n";
  449. X    }
  450. X}
  451. X
  452. X
  453. Xsub ftp'open_alarm
  454. X{
  455. X    die "timeout: open";
  456. X}
  457. X
  458. Xsub ftp'timed_open
  459. X{
  460. X    local( $site, $ftp_port, $retry_call, $attempts ) = @_;
  461. X    local( $connect_site, $connect_port );
  462. X    local( $res );
  463. X
  464. X    alarm( $timeout_open );
  465. X
  466. X    while( $attempts-- ){
  467. X        if( $ftp_show ){
  468. X            print $ftp'showfd "proxy connecting via $proxy_gateway [$proxy_ftp_port]\n" if $proxy;
  469. X            print $ftp'showfd "Connecting to $site";
  470. X            if( $ftp_port != 21 ){
  471. X                print $ftp'showfd " [port $ftp_port]";
  472. X            }
  473. X            print $ftp'showfd "\n";
  474. X        }
  475. X        
  476. X        if( $proxy ) {
  477. X            if( ! $proxy_gateway ) {
  478. X                # if not otherwise set
  479. X                $proxy_gateway = "internet-gateway";
  480. X            }
  481. X            if( $debug ) {
  482. X                print $ftp'showfd "using proxy services of $proxy_gateway, ";
  483. X                print $ftp'showfd "at $proxy_ftp_port\n";
  484. X            }
  485. X            $connect_site = $proxy_gateway;
  486. X            $connect_port = $proxy_ftp_port;
  487. X            $real_site = $site;
  488. X        }
  489. X        else {
  490. X            $connect_site = $site;
  491. X            $connect_port = $ftp_port;
  492. X        }
  493. X        if( ! &chat'open_port( $connect_site, $connect_port ) ){
  494. X            if( $retry_call ){
  495. X                print $ftp'showfd "Failed to connect\n" if $ftp_show;
  496. X                next;
  497. X            }
  498. X            else {
  499. X                print $ftp'showfd "proxy connection failed " if $proxy;
  500. X                print $ftp'showfd "Cannot open ftp to $connect_site\n" if $ftp_show;
  501. X                return 0;
  502. X            }
  503. X        }
  504. X        $res = &ftp'expect( $timeout,
  505. X            120, "service unavailable to $site", 0, 
  506. X            220, "ready for login to $site", 1,
  507. X            421, "service unavailable to $site, closing connection", 0);
  508. X        if( ! $res ){
  509. X            &chat'close();
  510. X            next;
  511. X        }
  512. X        return 1;
  513. X    }
  514. X    continue {
  515. X        print $ftp'showfd "Pausing between retries\n";
  516. X        sleep( $retry_pause );
  517. X    }
  518. X    return 0;
  519. X}
  520. X
  521. Xsub main'ftp__sighandler
  522. X{
  523. X    local( $sig ) = @_;
  524. X    local( $msg ) = "Caught a SIG$sig flagging connection down";
  525. X    $ftp'service_open = 0;
  526. X    if( $ftp_logger ){
  527. X        eval "&$ftp_logger( \$msg )";
  528. X    }
  529. X}
  530. X
  531. Xsub ftp'set_signals
  532. X{
  533. X    $ftp_logger = @_;
  534. X    $SIG{ 'PIPE' } = "ftp__sighandler";
  535. X}
  536. X
  537. X# Set the mapunixout and mapunixin functions
  538. Xsub ftp'set_namemap
  539. X{
  540. X    ($ftp'mapunixout, $ftp'mapunixin) = @_;
  541. X    if( $debug ) {
  542. X        print $ftp'showfd "mapunixout = $ftp'mapunixout, $mapunixin = $ftp'mapunixin\n";
  543. X    }
  544. X}
  545. X
  546. X
  547. Xsub ftp'open
  548. X{
  549. X    local( $site, $ftp_port, $retry_call, $attempts ) = @_;
  550. X
  551. X    local( $old_sig ) = $SIG{ 'ALRM' };
  552. X    $SIG{ 'ALRM' } = "ftp\'open_alarm";
  553. X
  554. X    local( $ret ) = eval "&timed_open( '$site', $ftp_port, $retry_call, $attempts )";
  555. X    alarm( 0 );
  556. X    $SIG{ 'ALRM' } = $old_sig;
  557. X
  558. X    if( $@ =~ /^timeout/ ){
  559. X        return -1;
  560. X    }
  561. X
  562. X    if( $ret ){
  563. X        $ftp'service_open = 1;
  564. X    }
  565. X
  566. X    return $ret;
  567. X}
  568. X
  569. Xsub ftp'login
  570. X{
  571. X    local( $remote_user, $remote_password ) = @_;
  572. X        local( $ret );
  573. X
  574. X    if( ! $ftp'service_open ){
  575. X        return 0;
  576. X    }
  577. X
  578. X    if( $proxy ){
  579. X        &ftp'send( "USER $remote_user@$site" );
  580. X    }
  581. X    else {
  582. X        &ftp'send( "USER $remote_user" );
  583. X    }
  584. X    $ret = &ftp'expect( $timeout,
  585. X        230, "$remote_user logged in", 1,
  586. X        331, "send password for $remote_user", 2,
  587. X
  588. X        500, "syntax error", 0,
  589. X        501, "syntax error", 0,
  590. X        530, "not logged in", 0,
  591. X        332, "account for login not supported", 0,
  592. X
  593. X        421, "service unavailable, closing connection", 99 );
  594. X    if( $ret == 99 ){
  595. X        &service_closed();
  596. X        $ret = 0;
  597. X    }
  598. X    if( $ret == 2 ){
  599. X        # A password is needed
  600. X        &ftp'send( "PASS $remote_password" );
  601. X
  602. X        $ret = &ftp'expect( $timeout,
  603. X            230, "$remote_user logged in", 1,
  604. X
  605. X            202, "command not implemented", 0,
  606. X            332, "account for login not supported", 0,
  607. X
  608. X            530, "not logged in", 0,
  609. X            500, "syntax error", 0,
  610. X            501, "syntax error", 0,
  611. X            503, "bad sequence of commands", 0, 
  612. X
  613. X            421, "service unavailable, closing connection", 99 );
  614. X        if( $ret == 99 ){
  615. X            &service_closed();
  616. X            $ret = 0;
  617. X        }
  618. X        if( $ret == 1 ){
  619. X            # Logged in
  620. X            return 1;
  621. X        }
  622. X    }
  623. X    # If I got here I failed to login
  624. X    return 0;
  625. X}
  626. X
  627. Xsub service_closed
  628. X{
  629. X    $ftp'service_open = 0;
  630. X    &chat'close();
  631. X}
  632. X
  633. Xsub ftp'close
  634. X{
  635. X    &ftp'quit();
  636. X    $ftp'service_open = 0;
  637. X    &chat'close();
  638. X}
  639. X
  640. X# Change directory
  641. X# return 1 if successful
  642. X# 0 on a failure
  643. Xsub ftp'cwd
  644. X{
  645. X    local( $dir ) = @_;
  646. X    local( $ret );
  647. X
  648. X    if( ! $ftp'service_open ){
  649. X        return 0;
  650. X    }
  651. X
  652. X    if( $ftp'mapunixout ){
  653. X        $dir = eval "&$ftp'mapunixout( \$dir, 'd' )";
  654. X    }
  655. X
  656. X    &ftp'send( "CWD $dir" );
  657. X
  658. X    $ret = &ftp'expect( $timeout,
  659. X        200, "working directory = $dir", 1,
  660. X        250, "working directory = $dir", 1,
  661. X
  662. X        500, "syntax error", 0,
  663. X        501, "syntax error", 0,
  664. X                502, "command not implemented", 0,
  665. X        530, "not logged in", 0,
  666. X                550, "cannot change directory", 0,
  667. X        421, "service unavailable, closing connection", 99 );
  668. X
  669. X    if( $ret == 99 ){
  670. X        &service_closed();
  671. X        $ret = 0;
  672. X    }
  673. X
  674. X    return $ret;
  675. X}
  676. X
  677. X# Get a full directory listing:
  678. X# &ftp'dir( remote LIST options )
  679. X# Start a list going with the given options.
  680. X# Presuming that the remote deamon uses the ls command to generate the
  681. X# data to send back then then you can send it some extra options (eg: -lRa)
  682. X# return 1 if sucessful and 0 on a failure
  683. Xsub ftp'dir_open
  684. X{
  685. X    local( $options ) = @_;
  686. X    local( $ret );
  687. X    
  688. X    if( ! $ftp'service_open ){
  689. X        return 0;
  690. X    }
  691. X
  692. X    if( ! &ftp'open_data_socket() ){
  693. X        return 0;
  694. X    }
  695. X    
  696. X    if( $options ){
  697. X        &ftp'send( "LIST $options" );
  698. X    }
  699. X    else {
  700. X        &ftp'send( "LIST" );
  701. X    }
  702. X    
  703. X    $ret = &ftp'expect( $timeout,
  704. X        150, "reading directory", 1,
  705. X    
  706. X        125, "data connection already open?", 0,
  707. X    
  708. X        450, "file unavailable", 0,
  709. X        500, "syntax error", 0,
  710. X        501, "syntax error", 0,
  711. X        502, "command not implemented", 0,
  712. X        530, "not logged in", 0,
  713. X    
  714. X            421, "service unavailable, closing connection", 99 );
  715. X    
  716. X    if( $ret == 99 ){
  717. X        &service_closed();
  718. X        $ret = 0;
  719. X    }
  720. X
  721. X    if( ! $ret ){
  722. X        &ftp'close_data_socket;
  723. X        return 0;
  724. X    }
  725. X    
  726. X    # 
  727. X    # the data should be coming at us now
  728. X    #
  729. X    
  730. X    # now accept
  731. X    accept(NS,S) || die "accept failed $!";
  732. X    
  733. X    return 1;
  734. X}
  735. X
  736. X
  737. X# Close down reading the result of a remote ls command
  738. X# return 1 if successful and 0 on failure
  739. Xsub ftp'dir_close
  740. X{
  741. X    local( $ret );
  742. X
  743. X    if( ! $ftp'service_open ){
  744. X        return 0;
  745. X    }
  746. X
  747. X    # read the close
  748. X    #
  749. X    $ret = &ftp'expect($timeout,
  750. X            226, "", 1,     # transfer complete, closing connection
  751. X            250, "", 1,     # action completed
  752. X
  753. X            425, "can't open data connection", 0,
  754. X            426, "connection closed, transfer aborted", 0,
  755. X            451, "action aborted, local error", 0,
  756. X            421, "service unavailable, closing connection", 99 );
  757. X    if( $ret == 99 ){
  758. X        &service_closed();
  759. X        $ret = 0;
  760. X    }
  761. X
  762. X    # shut down our end of the socket
  763. X    &ftp'close_data_socket;
  764. X
  765. X    if( ! $ret ){
  766. X        return 0;
  767. X    }
  768. X
  769. X    return 1;
  770. X}
  771. X
  772. X# Quit from the remote ftp server
  773. X# return 1 if successful and 0 on failure
  774. Xsub ftp'quit
  775. X{
  776. X    local( $ret );
  777. X
  778. X    $site_command_check = 0;
  779. X    @site_command_list = ();
  780. X
  781. X    if( ! $ftp'service_open ){
  782. X        return 0;
  783. X    }
  784. X
  785. X    &ftp'send( "QUIT" );
  786. X
  787. X    $ret = &ftp'expect( $timeout, 
  788. X        221, "Goodbye", 1,     # transfer complete, closing connection
  789. X        500, "error quitting??", 0,
  790. X        421, "service unavailable, closing connection", 99 );
  791. X    if( $ret == 99 ){
  792. X        &service_closed();
  793. X        $ret = 0;
  794. X    }
  795. X    return $ret;
  796. X}
  797. X
  798. Xsub ftp'read_alarm
  799. X{
  800. X    die "timeout: read";
  801. X}
  802. X
  803. Xsub ftp'timed_read
  804. X{
  805. X    alarm( $timeout_read );
  806. X    return sysread( NS, $buf, $ftpbufsize );
  807. X}
  808. X
  809. Xsub ftp'read
  810. X{
  811. X    $SIG{ 'ALRM' } = "ftp\'read_alarm";
  812. X
  813. X    if( ! $ftp'service_open ){
  814. X        return -1;
  815. X    }
  816. X
  817. X    local( $ret ) = eval '&timed_read()';
  818. X    alarm( 0 );
  819. X
  820. X    if( $@ =~ /^timeout/ ){
  821. X        return -1;
  822. X    }
  823. X    return $ret;
  824. X}
  825. X
  826. X# Get a remote file back into a local file.
  827. X# If no loc_fname passed then uses rem_fname.
  828. X# returns 1 on success and 0 on failure
  829. Xsub ftp'get
  830. X{
  831. X    local($rem_fname, $loc_fname, $restart ) = @_;
  832. X    local( $ret );
  833. X    
  834. X    if( ! $ftp'service_open ){
  835. X        return 0;
  836. X    }
  837. X
  838. X    if( $loc_fname eq "" ){
  839. X        $loc_fname = $rem_fname;
  840. X    }
  841. X    
  842. X    if( ! &ftp'open_data_socket() ){
  843. X        print $ftp'showfd "Cannot open data socket\n";
  844. X        return 0;
  845. X    }
  846. X
  847. X    if( $loc_fname ne '-' ){
  848. X        # Find the size of the target file
  849. X        local( $restart_at ) = &ftp'filesize( $loc_fname );
  850. X        if( $restart && $restart_at > 0 && &ftp'restart( $restart_at ) ){
  851. X            $restart = 1;
  852. X            # Make sure the file can be updated
  853. X            chmod( 0644, $loc_fname );
  854. X        }
  855. X        else {
  856. X            $restart = 0;
  857. X            unlink( $loc_fname );
  858. X        }
  859. X    }
  860. X
  861. X    if( $ftp'mapunixout ){
  862. X        $rem_fname = eval "&$ftp'mapunixout( \$rem_fname, 'f' )";
  863. X    }
  864. X
  865. X    &ftp'send( "RETR $rem_fname" );
  866. X    
  867. X    $ret = &ftp'expect( $timeout, 
  868. X        150, "receiving $rem_fname", 1,
  869. X
  870. X        125, "data connection already open?", 0,
  871. X        450, "file unavailable", 2,
  872. X        550, "file unavailable", 2,
  873. X        500, "syntax error", 0,
  874. X        501, "syntax error", 0,
  875. X        530, "not logged in", 0,
  876. X
  877. X        421, "service unavailable, closing connection", 99 );
  878. X    if( $ret == 99 ){
  879. X        &service_closed();
  880. X        $ret = 0;
  881. X    }
  882. X    if( $ret != 1 ){
  883. X        print $ftp'showfd "Failure on 'RETR $rem_fname' command\n";
  884. X
  885. X        # shut down our end of the socket
  886. X        &ftp'close_data_socket;
  887. X
  888. X        return 0;
  889. X    }
  890. X
  891. X    # 
  892. X    # the data should be coming at us now
  893. X    #
  894. X
  895. X    # now accept
  896. X    accept( NS, S ) || die "accept failed: $!";
  897. X
  898. X    #
  899. X    #  open the local fname
  900. X    #  concatenate on the end if restarting, else just overwrite
  901. X    if( !open( FH, ($restart ? '>>' : '>') . $loc_fname ) ){
  902. X        print $ftp'showfd "Cannot create local file $loc_fname\n";
  903. X
  904. X        # shut down our end of the socket
  905. X        &ftp'close_data_socket;
  906. X
  907. X        return 0;
  908. X    }
  909. X
  910. X    local( $start_time ) = time;
  911. X    local( $bytes, $lasthash, $hashes ) = (0, 0, 0);
  912. X    while( ($len = &ftp'read()) > 0 ){
  913. X        $bytes += $len;
  914. X        if( $strip_cr ){
  915. X            $ftp'buf =~ s/\r//g;
  916. X        }
  917. X        if( $ftp_show ){
  918. X            while( $bytes > ($lasthash + $ftp'hashevery) ){
  919. X                print $ftp'showfd '#';
  920. X                $lasthash += $ftp'hashevery;
  921. X                $hashes++;
  922. X                if( ($hashes % $ftp'hashnl) == 0 ){
  923. X                    print $ftp'showfd "\n";
  924. X                }
  925. X            }
  926. X        }
  927. X        if( ! print FH $ftp'buf ){
  928. X            print $ftp'showfd "\nfailed to write data";
  929. X            $bytes = -1;
  930. X            last;
  931. X        }
  932. X    }
  933. X    close( FH );
  934. X
  935. X    # shut down our end of the socket
  936. X    &ftp'close_data_socket;
  937. X
  938. X    if( $len < 0 ){
  939. X        print $ftp'showfd "\ntimed out reading data!\n";
  940. X
  941. X        return 0;
  942. X    }
  943. X        
  944. X    if( $ftp_show && $bytes > 0 ){
  945. X        if( $hashes && ($hashes % $ftp'hashnl) != 0 ){
  946. X            print $ftp'showfd "\n";
  947. X        }
  948. X        local( $secs ) = (time - $start_time);
  949. X        if( $secs <= 0 ){
  950. X            $secs = 1; # To avoid a divide by zero;
  951. X        }
  952. X
  953. X        local( $rate ) = int( $bytes / $secs );
  954. X        print $ftp'showfd "Got $bytes bytes ($rate bytes/sec)\n";
  955. X    }
  956. X
  957. X    #
  958. X    # read the close
  959. X    #
  960. X
  961. X    $ret = &ftp'expect( $timeout, 
  962. X        226, "Got file", 1,     # transfer complete, closing connection
  963. X            250, "Got file", 1,     # action completed
  964. X    
  965. X            110, "restart not supported", 0,
  966. X            425, "can't open data connection", 0,
  967. X            426, "connection closed, transfer aborted", 0,
  968. X            451, "action aborted, local error", 0,
  969. X        550, "permission denied", 0,
  970. X
  971. X        421, "service unavailable, closing connection", 99 );
  972. X    if( $ret == 99 ){
  973. X        &service_closed();
  974. X        $ret = 0;
  975. X    }
  976. X
  977. X    if( $ret && $bytes < 0 ){
  978. X        $ret = 0;
  979. X    }
  980. X
  981. X    return $ret;
  982. X}
  983. X
  984. Xsub ftp'delete
  985. X{
  986. X    local( $rem_fname ) = @_;
  987. X    local( $ret );
  988. X
  989. X    if( ! $ftp'service_open ){
  990. X        return 0;
  991. X    }
  992. X
  993. X    if( $ftp'mapunixout ){
  994. X        $rem_fname = eval "&$ftp'mapunixout( \$rem_fname, 'f' )";
  995. X    }
  996. X
  997. X    &ftp'send( "DELE $rem_fname" );
  998. X
  999. X    $ret = &ftp'expect( $timeout, 
  1000. X        250, "Deleted $rem_fname", 1,
  1001. X        550, "Permission denied", 0,
  1002. X
  1003. X        421, "service unavailable, closing connection", 99 );
  1004. X    if( $ret == 99 ){
  1005. X        &service_closed();
  1006. X        $ret = 0;
  1007. X    }
  1008. X
  1009. X    return $ret == 1;
  1010. X}
  1011. X
  1012. Xsub ftp'deldir
  1013. X{
  1014. X    local( $fname ) = @_;
  1015. X
  1016. X    # not yet implemented
  1017. X    # RMD
  1018. X}
  1019. X
  1020. X# UPDATE ME!!!!!!
  1021. X# Add in the hash printing and newline conversion
  1022. Xsub ftp'put
  1023. X{
  1024. X    local( $loc_fname, $rem_fname ) = @_;
  1025. X    local( $strip_cr );
  1026. X    
  1027. X    if( ! $ftp'service_open ){
  1028. X        return 0;
  1029. X    }
  1030. X
  1031. X    if( $loc_fname eq "" ){
  1032. X        $loc_fname = $rem_fname;
  1033. X    }
  1034. X    
  1035. X    if( ! &ftp'open_data_socket() ){
  1036. X        return 0;
  1037. X    }
  1038. X    
  1039. X    if( $ftp'mapunixout ){
  1040. X        $rem_fname = eval "&$ftp'mapunixout( \$rem_fname, 'f' )";
  1041. X    }
  1042. X
  1043. X    &ftp'send( "STOR $rem_fname" );
  1044. X    
  1045. X    # 
  1046. X    # the data should be coming at us now
  1047. X    #
  1048. X    
  1049. X    local( $ret ) =
  1050. X    &ftp'expect( $timeout, 
  1051. X        150, "sending $loc_fname", 1,
  1052. X
  1053. X        125, "data connection already open?", 0,
  1054. X        450, "file unavailable", 0,
  1055. X        532, "need account for storing files", 0,
  1056. X        452, "insufficient storage on system", 0,
  1057. X        553, "file name not allowed", 0,
  1058. X        500, "syntax error", 0,
  1059. X        501, "syntax error", 0,
  1060. X        530, "not logged in", 0,
  1061. X
  1062. X        421, "service unavailable, closing connection", 99 );
  1063. X    if( $ret == 99 ){
  1064. X        &service_closed();
  1065. X        $ret = 0;
  1066. X    }
  1067. X
  1068. X    if( $ret != 1 ){
  1069. X        # shut down our end of the socket
  1070. X        &ftp'close_data_socket;
  1071. X
  1072. X        return 0;
  1073. X    }
  1074. X
  1075. X
  1076. X    # 
  1077. X    # the data should be coming at us now
  1078. X    #
  1079. X    
  1080. X    # now accept
  1081. X    accept(NS,S) || die "accept failed: $!";
  1082. X    
  1083. X    #
  1084. X    #  open the local fname
  1085. X    #
  1086. X    if( !open(FH, "<$loc_fname") ){
  1087. X        print $ftp'showfd "Cannot open local file $loc_fname\n";
  1088. X
  1089. X        # shut down our end of the socket
  1090. X        &ftp'close_data_socket;
  1091. X
  1092. X        return 0;
  1093. X    }
  1094. X    
  1095. X    while( <FH> ){
  1096. X        if( ! $ftp'service_open ){
  1097. X            last;
  1098. X        }
  1099. X        print NS ;
  1100. X    }
  1101. X    close( FH );
  1102. X    
  1103. X    # shut down our end of the socket to signal EOF
  1104. X    &ftp'close_data_socket;
  1105. X    
  1106. X    #
  1107. X    # read the close
  1108. X    #
  1109. X    
  1110. X    $ret = &ftp'expect( $timeout, 
  1111. X        226, "file put", 1,     # transfer complete, closing connection
  1112. X        250, "file put", 1,     # action completed
  1113. X    
  1114. X        110, "restart not supported", 0,
  1115. X        425, "can't open data connection", 0,
  1116. X        426, "connection closed, transfer aborted", 0,
  1117. X        451, "action aborted, local error", 0,
  1118. X        551, "page type unknown", 0,
  1119. X        552, "storage allocation exceeded", 0,
  1120. X    
  1121. X        421, "service unavailable, closing connection", 99 );
  1122. X    if( $ret == 99 ){
  1123. X        &service_closed();
  1124. X        $ret = 0;
  1125. X    }
  1126. X    if( ! $ret ){
  1127. X        print $ftp'showfd "Failure on 'STOR $loc_fname' command\n";
  1128. X    }
  1129. X    return $ret;
  1130. X}
  1131. X
  1132. Xsub ftp'restart
  1133. X{
  1134. X    local( $restart_point, $ret ) = @_;
  1135. X
  1136. X    if( ! $ftp'service_open ){
  1137. X        return 0;
  1138. X    }
  1139. X
  1140. X    &ftp'send( "REST $restart_point" );
  1141. X
  1142. X    # 
  1143. X    # see what they say
  1144. X
  1145. X    $ret = &ftp'expect( $timeout, 
  1146. X        350, "restarting at $restart_point", 1,
  1147. X               
  1148. X        500, "syntax error", 0,
  1149. X        501, "syntax error", 0,
  1150. X        502, "REST not implemented", 2,
  1151. X        530, "not logged in", 0,
  1152. X        554, "REST not implemented", 2,
  1153. X               
  1154. X        421, "service unavailable, closing connection", 99 );
  1155. X    if( $ret == 99 ){
  1156. X        &service_closed();
  1157. X        $ret = 0;
  1158. X    }
  1159. X    return $ret;
  1160. X}
  1161. X
  1162. X# Set the file transfer type
  1163. Xsub ftp'type
  1164. X{
  1165. X    local( $type ) = @_;
  1166. X
  1167. X    if( ! $ftp'service_open ){
  1168. X        return 0;
  1169. X    }
  1170. X
  1171. X    &ftp'send( "TYPE $type" );
  1172. X
  1173. X    # 
  1174. X    # see what they say
  1175. X
  1176. X    $ret = &ftp'expect( $timeout, 
  1177. X        200, "file type set to $type", 1,
  1178. X               
  1179. X        500, "syntax error", 0,
  1180. X        501, "syntax error", 0,
  1181. X        504, "Invalid form or byte size for type $type", 0,
  1182. X               
  1183. X        421, "service unavailable, closing connection", 99 );
  1184. X    if( $ret == 99 ){
  1185. X        &service_closed();
  1186. X        $ret = 0;
  1187. X    }
  1188. X    return $ret;
  1189. X}
  1190. X
  1191. X$site_command_check = 0;
  1192. X@site_command_list = ();
  1193. X
  1194. X# routine to query the remote server for 'SITE' commands supported
  1195. Xsub ftp'site_commands
  1196. X{
  1197. X    local( $ret );
  1198. X    
  1199. X    if( ! $ftp'service_open ){
  1200. X        return 0;
  1201. X    }
  1202. X
  1203. X    # if we havent sent a 'HELP SITE', send it now
  1204. X    if( !$site_command_check ){
  1205. X    
  1206. X        $site_command_check = 1;
  1207. X    
  1208. X        &ftp'send( "HELP SITE" );
  1209. X    
  1210. X        # assume the line in the HELP SITE response with the 'HELP'
  1211. X        # command is the one for us
  1212. X        $ret = &ftp'expect( $timeout,
  1213. X            ".*HELP.*", "", "\$1",
  1214. X            214, "", "0",
  1215. X            202, "", "0",
  1216. X            421, "service unavailable, closing connection", "99" );
  1217. X        if( $ret == 99 ){
  1218. X            &service_closed();
  1219. X            $ret = "0";
  1220. X        }
  1221. X    
  1222. X        if( $ret eq "0" ){
  1223. X            print $ftp'showfd "No response from HELP SITE\n" if( $ftp_show );
  1224. X        }
  1225. X    
  1226. X        @site_command_list = split(/\s+/, $ret);
  1227. X    }
  1228. X    
  1229. X    return @site_command_list;
  1230. X}
  1231. X
  1232. X# return the pwd, or null if we can't get the pwd
  1233. Xsub ftp'pwd
  1234. X{
  1235. X    local( $ret, $cwd );
  1236. X
  1237. X    if( ! $ftp'service_open ){
  1238. X        return 0;
  1239. X    }
  1240. X
  1241. X    &ftp'send( "PWD" );
  1242. X
  1243. X    # 
  1244. X    # see what they say
  1245. X
  1246. X    $ret = &ftp'expect( $timeout, 
  1247. X        257, "working dir is", 1,
  1248. X        500, "syntax error", 0,
  1249. X        501, "syntax error", 0,
  1250. X        502, "PWD not implemented", 0,
  1251. X        550, "file unavailable", 0,
  1252. X
  1253. X        421, "service unavailable, closing connection", 99 );
  1254. X    if( $ret == 99 ){
  1255. X        &service_closed();
  1256. X        $ret = 0;
  1257. X    }
  1258. X    if( $ret ){
  1259. X        if( $ftp'response =~ /^257\s"(.*)"\s.*$/ ){
  1260. X            $cwd = $1;
  1261. X        }
  1262. X    }
  1263. X    return $cwd;
  1264. X}
  1265. X
  1266. X# return 1 for success, 0 for failure
  1267. Xsub ftp'mkdir
  1268. X{
  1269. X    local( $path ) = @_;
  1270. X    local( $ret );
  1271. X
  1272. X    if( ! $ftp'service_open ){
  1273. X        return 0;
  1274. X    }
  1275. X
  1276. X    if( $ftp'mapunixout ){
  1277. X        $path = eval "&$ftp'mapunixout( \$path, 'f' )";
  1278. X    }
  1279. X
  1280. X    &ftp'send( "MKD $path" );
  1281. X
  1282. X    # 
  1283. X    # see what they say
  1284. X
  1285. X    $ret = &ftp'expect( $timeout, 
  1286. X        257, "made directory $path", 1,
  1287. X               
  1288. X        500, "syntax error", 0,
  1289. X        501, "syntax error", 0,
  1290. X        502, "MKD not implemented", 0,
  1291. X        530, "not logged in", 0,
  1292. X        550, "file unavailable", 0,
  1293. X
  1294. X        421, "service unavailable, closing connection", 99 );
  1295. X    if( $ret == 99 ){
  1296. X        &service_closed();
  1297. X        $ret = 0;
  1298. X    }
  1299. X    return $ret;
  1300. X}
  1301. X
  1302. X# return 1 for success, 0 for failure
  1303. Xsub ftp'chmod
  1304. X{
  1305. X    local( $path, $mode ) = @_;
  1306. X    local( $ret );
  1307. X
  1308. X    if( ! $ftp'service_open ){
  1309. X        return 0;
  1310. X    }
  1311. X
  1312. X    if( $ftp'mapunixout ){
  1313. X        $path = eval "&$ftp'mapunixout( \$path, 'f' )";
  1314. X    }
  1315. X
  1316. X    &ftp'send( sprintf( "SITE CHMOD %o $path", $mode ) );
  1317. X
  1318. X    # 
  1319. X    # see what they say
  1320. X
  1321. X    $ret = &ftp'expect( $timeout, 
  1322. X        200, "chmod $mode $path succeeded", 1,
  1323. X               
  1324. X        500, "syntax error", 0,
  1325. X        501, "syntax error", 0,
  1326. X        502, "CHMOD not implemented", 0,
  1327. X        530, "not logged in", 0,
  1328. X        550, "file unavailable", 0,
  1329. X
  1330. X        421, "service unavailable, closing connection", 99 );
  1331. X    if( $ret == 99 ){
  1332. X        &service_closed();
  1333. X        $ret = 0;
  1334. X    }
  1335. X    return $ret;
  1336. X}
  1337. X
  1338. X# rename a file
  1339. Xsub ftp'rename
  1340. X{
  1341. X    local( $old_name, $new_name ) = @_;
  1342. X    local( $ret );
  1343. X
  1344. X    if( ! $ftp'service_open ){
  1345. X        return 0;
  1346. X    }
  1347. X
  1348. X    if( $ftp'mapunixout ){
  1349. X        $old_name = eval "&$ftp'mapunixout( \$old_name, 'f' )";
  1350. X    }
  1351. X
  1352. X    &ftp'send( "RNFR $old_name" );
  1353. X
  1354. X    # 
  1355. X    # see what they say
  1356. X
  1357. X    $ret = &ftp'expect( $timeout, 
  1358. X        350, "", 1,
  1359. X               
  1360. X        500, "syntax error", 0,
  1361. X        501, "syntax error", 0,
  1362. X        502, "RNFR not implemented", 0,
  1363. X        530, "not logged in", 0,
  1364. X        550, "file unavailable", 0,
  1365. X        450, "file unavailable", 0,
  1366. X               
  1367. X        421, "service unavailable, closing connection", 99 );
  1368. X    if( $ret == 99 ){
  1369. X        &service_closed();
  1370. X        $ret = 0;
  1371. X    }
  1372. X
  1373. X    # check if the "rename from" occurred ok
  1374. X    if( $ret ){
  1375. X        if( $ftp'mapunixout ){
  1376. X            $new_name = eval "&$ftp'mapunixout( \$new_name, 'f' )";
  1377. X        }
  1378. X
  1379. X        &ftp'send( "RNTO $new_name" );
  1380. X    
  1381. X        # 
  1382. X        # see what they say
  1383. X    
  1384. X        $ret = &ftp'expect( $timeout, 
  1385. X            250, "rename $old_name to $new_name", 1, 
  1386. X
  1387. X            500, "syntax error", 0,
  1388. X            501, "syntax error", 0,
  1389. X            502, "RNTO not implemented", 0,
  1390. X            503, "bad sequence of commands", 0,
  1391. X            530, "not logged in", 0,
  1392. X            532, "need account for storing files", 0,
  1393. X            553, "file name not allowed", 0,
  1394. X                   
  1395. X            421, "service unavailable, closing connection", 99 );
  1396. X        if( $ret == 99 ){
  1397. X            &service_closed();
  1398. X            $ret = 0;
  1399. X        }
  1400. X    }
  1401. X
  1402. X    return $ret;
  1403. X}
  1404. X
  1405. X
  1406. Xsub ftp'quote
  1407. X{
  1408. X    local( $cmd ) = @_;
  1409. X    local( $ret );
  1410. X
  1411. X    if( ! $ftp'service_open ){
  1412. X        return 0;
  1413. X    }
  1414. X
  1415. X    &ftp'send( $cmd );
  1416. X
  1417. X    $ret = &ftp'expect( $timeout, 
  1418. X        200, "Remote '$cmd' OK", 1,
  1419. X        500, "error in remote '$cmd'", 0,
  1420. X        421, "service unavailable, closing connection", 99 );
  1421. X    if( $ret == 99 ){
  1422. X        &service_closed();
  1423. X        $ret = 0;
  1424. X    }
  1425. X    return $ret;
  1426. X}
  1427. X
  1428. X# ------------------------------------------------------------------------------
  1429. X# These are the lower level support routines
  1430. X
  1431. Xsub ftp'expectgot
  1432. X{
  1433. X    ($ftp'response, $ftp'fatalerror) = @_;
  1434. X    if( $ftp_show ){
  1435. X        print $ftp'showfd "$ftp'response\n";
  1436. X    }
  1437. X    # Zap the chat2 buffer
  1438. X    undef( $chat'S );
  1439. X}
  1440. X
  1441. X#
  1442. X#  create the list of parameters for chat'expect
  1443. X#
  1444. X#  ftp'expect(time_out, {value, string_to_print, return value});
  1445. X#     if the string_to_print is "" then nothing is printed
  1446. X#  the last response is stored in $ftp'response
  1447. X#
  1448. X# NOTE: lmjm has changed this code such that the string_to_print is
  1449. X# ignored and the string sent back from the remote system is printed
  1450. X# instead.
  1451. X#
  1452. Xsub ftp'expect {
  1453. X    local( $ret );
  1454. X    local( $time_out );
  1455. X    local( @expect_args );
  1456. X    local( $code, $pre );
  1457. X    
  1458. X    $ftp'response = '';
  1459. X    $ftp'fatalerror = 0;
  1460. X
  1461. X    $time_out = shift( @_ );
  1462. X    
  1463. X    while( @_ ){
  1464. X        $code = shift( @_ );
  1465. X        $pre = '^';
  1466. X        if( $code =~ /^\d+$/ ){
  1467. X            $pre = "[.|\n]*^";
  1468. X        }
  1469. X        push( @expect_args, "$pre(" . $code . " .*)\\015\\n" );
  1470. X        shift( @_ );
  1471. X        push( @expect_args, 
  1472. X            "&expectgot( \$1, 0 ); " . shift( @_ ) );
  1473. X    }
  1474. X    
  1475. X    # Treat all unrecognised lines as continuations
  1476. X    push( @expect_args, "^(.*)\\015\\n" );
  1477. X    push( @expect_args, "&expectgot( \$1, 0 ); 100" );
  1478. X    
  1479. X    # add patterns TIMEOUT and EOF
  1480. X    
  1481. X    push( @expect_args, 'TIMEOUT' );
  1482. X    push( @expect_args, "&expectgot( 'timed out', 0 ); 0" );
  1483. X    
  1484. X    push( @expect_args, 'EOF' );
  1485. X    push( @expect_args, "&expectgot( 'remote server gone away', 1 ); 99" );
  1486. X    
  1487. X    if( $ftp_show > 9 ){
  1488. X        &printargs( $time_out, @expect_args );
  1489. X    }
  1490. X    
  1491. X    $ret = &chat'expect( $time_out, @expect_args );
  1492. X    if( $ret == 100 ){
  1493. X        # we saw a continuation line, wait for the end
  1494. X        push( @expect_args, "^.*\n" );
  1495. X        push( @expect_args, "100" );
  1496. X    
  1497. X        while( $ret == 100 ){
  1498. X            if( $ftp_show > 9 ){
  1499. X                &printargs( $time_out, @expect_args );
  1500. X            }
  1501. X            $ret = &chat'expect( $time_out, @expect_args );
  1502. X        }
  1503. X    }
  1504. X
  1505. X    return $ret;
  1506. X}
  1507. X
  1508. X
  1509. X
  1510. X#
  1511. X#  opens NS for io
  1512. X#
  1513. Xsub ftp'open_data_socket
  1514. X{
  1515. X    local( $sockaddr, $port );
  1516. X    local( $type, $myaddr, $a, $b, $c, $d );
  1517. X    local( $mysockaddr, $family, $hi, $lo );
  1518. X    
  1519. X    $sockaddr = 'S n a4 x8';
  1520. X
  1521. X    ($a,$b,$c,$d) = unpack( 'C4', $chat'thisaddr );
  1522. X    $this = $chat'thisproc;
  1523. X    
  1524. X    socket( S, $pf_inet, $sock_stream, $tcp_proto ) || die "socket: $!";
  1525. X    bind( S, $this ) || die "bind: $!";
  1526. X    
  1527. X    # get the port number
  1528. X    $mysockaddr = getsockname( S );
  1529. X    ($family, $port, $myaddr) = unpack( $sockaddr, $mysockaddr );
  1530. X    
  1531. X    $hi = ($port >> 8) & 0x00ff;
  1532. X    $lo = $port & 0x00ff;
  1533. X    
  1534. X    #
  1535. X    # we MUST do a listen before sending the port otherwise
  1536. X    # the PORT may fail
  1537. X    #
  1538. X    listen( S, 5 ) || die "listen";
  1539. X    
  1540. X    &ftp'send( "PORT $a,$b,$c,$d,$hi,$lo" );
  1541. X    
  1542. X    return &ftp'expect($timeout,
  1543. X        200, "PORT command successful", 1,
  1544. X        250, "PORT command successful", 1 ,
  1545. X
  1546. X        500, "syntax error", 0,
  1547. X        501, "syntax error", 0,
  1548. X        530, "not logged in", 0,
  1549. X
  1550. X        421, "service unavailable, closing connection", 0);
  1551. X}
  1552. X    
  1553. Xsub ftp'close_data_socket
  1554. X{
  1555. X    close(NS);
  1556. X}
  1557. X
  1558. Xsub ftp'send
  1559. X{
  1560. X    local($send_cmd) = @_;
  1561. X
  1562. X    if( $send_cmd =~ /\n/ ){
  1563. X        print $ftp'showfd "ERROR, \\n in send string for $send_cmd\n";
  1564. X    }
  1565. X    
  1566. X    if( $ftp_show ){
  1567. X        local( $sc ) = $send_cmd;
  1568. X
  1569. X        if( $send_cmd =~ /^PASS/){
  1570. X            $sc = "PASS <somestring>";
  1571. X        }
  1572. X        print $ftp'showfd "---> $sc\n";
  1573. X    }
  1574. X    
  1575. X    &chat'print( "$send_cmd\r\n" );
  1576. X}
  1577. X
  1578. Xsub ftp'printargs
  1579. X{
  1580. X    while( @_ ){
  1581. X        print $ftp'showfd shift( @_ ) . "\n";
  1582. X    }
  1583. X}
  1584. X
  1585. Xsub ftp'filesize
  1586. X{
  1587. X    local( $fname ) = @_;
  1588. X
  1589. X    if( ! -f $fname ){
  1590. X        return -1;
  1591. X    }
  1592. X
  1593. X    return (stat( _ ))[ 7 ];
  1594. X    
  1595. X}
  1596. X
  1597. X# make this package return true
  1598. X1;
  1599. END_OF_FILE
  1600.   if test 28699 -ne `wc -c <'ftp.pl'`; then
  1601.     echo shar: \"'ftp.pl'\" unpacked with wrong size!
  1602.   fi
  1603.   # end of 'ftp.pl'
  1604. fi
  1605. if test -f 'help_english' -a "${1}" != "-c" ; then 
  1606.   echo shar: Will not clobber existing file \"'help_english'\"
  1607. else
  1608.   echo shar: Extracting \"'help_english'\" \(2921 characters\)
  1609.   sed "s/^X//" >'help_english' <<'END_OF_FILE'
  1610. Xftpmail@$hostname - ftp's files and sends them back via electronic mail.
  1611. X
  1612. XIf you have problems please email $managers_email
  1613. Xand quote the following line:
  1614. X$Revision
  1615. X
  1616. X
  1617. X>>Valid commands to the ftpmail gateway are:
  1618. X
  1619. Xreply-to email-address        Who to send the response to.  This is
  1620. X                 optional and defaults to the users email address
  1621. X
  1622. X>>Followed by one of:
  1623. X
  1624. Xhelp                Just send back help
  1625. Xdelete jobid            Delete the given job
  1626. Xopen [site [user [pass]]]    Site to ftp to.  Defaults are
  1627. X                 $default_site anonymous reply-to-address.
  1628. X
  1629. X>>If there was an open then it can be followed by up to $max_cmds of the
  1630. X>>following commands
  1631. X
  1632. Xcd pathname            Change directory.
  1633. Xls [pathname]            short listing of pathname. Default pathname
  1634. X                 is current directory.
  1635. Xdir [pathname]            long listing of pathname. Default pathname
  1636. X                 is current directory.
  1637. Xget pathname            Get a file and email it back.
  1638. X
  1639. Xcompress            Compress files/dir-listings before emailing back
  1640. Xgzip                Gzip files/dir-listings before emailing back
  1641. X
  1642. Xuuencode
  1643. Xbtoa
  1644. X                These are mutually exclusive options for
  1645. X                converting a binary file before emailing.
  1646. X                (Default is uuencode.)
  1647. X
  1648. Xforce uuencode
  1649. Xforce btoa
  1650. X                Force all files or directory listings to
  1651. X                be encoded before sending back.
  1652. X                There is no default.
  1653. X
  1654. Xmime
  1655. X                Send the message as a Mime Verson 1.0 message.
  1656. X                Text will be sent as text/plain charset=US-ASCII
  1657. X                Non-text as application/octet-stream.
  1658. X                If the file is splitup then it will be sent
  1659. X                as a message/partial.
  1660. X
  1661. Xforce mime
  1662. X                As mime but force text files to be sent as
  1663. X                application/octet-stream
  1664. X
  1665. Xno [compress|gzip|uuencode|btoa|mime]
  1666. X                Turn the option off.
  1667. X
  1668. Xsize num[K|M]
  1669. X                Set the max size a file can be before it
  1670. X                is split up and emailed back in parts to
  1671. X                the given number of Kilo or Mega bytes.
  1672. X                This is limited to $max_size.
  1673. X
  1674. Xmode binary
  1675. Xmode ascii
  1676. X                Change the mode selected for the get
  1677. X                command.  Defaults to binary.
  1678. Xquit                End of input - ignore any following lines.
  1679. X
  1680. X
  1681. XExample scripts are:
  1682. X
  1683. Xopen
  1684. Xdir
  1685. Xquit
  1686. X    Connect to $default_site and send back the contents of the top level
  1687. X    directory
  1688. X
  1689. Xreply-to lmjm@doc.ic.ac.uk
  1690. Xopen
  1691. Xcd unix
  1692. Xget buffer.shar
  1693. Xquit
  1694. X    Connect to $default_site and send back the file buffer.shar to
  1695. X    lmjm@doc.ic.ac.uk
  1696. X
  1697. Xopen src.doc.ic.ac.uk
  1698. Xcd graphics/X11/X.V11R5
  1699. Xget ls-lR.Z
  1700. Xcd ../contrib
  1701. Xcompress
  1702. Xls -ltra
  1703. Xquit
  1704. X    Connect to src.doc.ic.ac.uk, send back the file ls-lR.Z in
  1705. X    graphics/X11/X.V11R5.  As this is a binary file it has to be transfered
  1706. X    in binary mode.  Because it is binary it will automatically
  1707. X    be uuencoded (the default binary encoder).  Then change to ../contrib
  1708. X    and mail back a compressed directory listing.  Although compressing ls
  1709. X    output makes it binary, which then has to be encoded, it still ends up
  1710. X    smaller than the original.
  1711. X
  1712. Xopen
  1713. Xcd graphics/X11/X.V11R5/fixes
  1714. Xget fix-08
  1715. Xget fix-09
  1716. Xget sunGX.uu
  1717. Xquit
  1718. X    Retrieve some recent X fixes
  1719. X
  1720. X    
  1721. Xopen
  1722. Xcd gnu
  1723. Xatob
  1724. Xmode binary
  1725. Xget emacs-18.57.tar.Z
  1726. Xquit
  1727. X    
  1728. END_OF_FILE
  1729.   if test 2921 -ne `wc -c <'help_english'`; then
  1730.     echo shar: \"'help_english'\" unpacked with wrong size!
  1731.   fi
  1732.   # end of 'help_english'
  1733. fi
  1734. if test -f 'q.pl' -a "${1}" != "-c" ; then 
  1735.   echo shar: Will not clobber existing file \"'q.pl'\"
  1736. else
  1737.   echo shar: Extracting \"'q.pl'\" \(14086 characters\)
  1738.   sed "s/^X//" >'q.pl' <<'END_OF_FILE'
  1739. X#!/usr/bin/perl -s
  1740. X# Very simple ftpmail system
  1741. X# Queue a transfer to be done
  1742. X# By Lee McLoughlin <lmjm@doc.ic.ac.uk>
  1743. X#  You can do what you like with this except claim that you wrote it or
  1744. X#  give copies with changes not approved by Lee.  Neither Lee nor any other
  1745. X#  organisation can be held liable for any problems caused by the use or
  1746. X#  storage of this package.
  1747. X#
  1748. X# $Header: /a/swan/home/swan/staff/csg/lmjm/src/perl/mirror/ftpmail/RCS/q.pl,v 1.13 1993/05/07 19:05:52 lmjm Exp lmjm $
  1749. X# $Log: q.pl,v $
  1750. X# Revision 1.13  1993/05/07  19:05:52  lmjm
  1751. X# Added Chris's fixed not_ok code.
  1752. X#
  1753. X# Revision 1.12  1993/04/28  18:19:20  lmjm
  1754. X# Handle size suffix correctly.
  1755. X#
  1756. X# Revision 1.11  1993/04/25  20:27:55  lmjm
  1757. X# Cut new release
  1758. X#
  1759. X# Revision 1.10  1993/04/25  14:15:11  lmjm
  1760. X# Allow for multiple help files (one per language).
  1761. X#
  1762. X# Revision 1.9  1993/04/23  23:27:07  lmjm
  1763. X# Massive renaming for sys5.
  1764. X# Also shrink qfile names.
  1765. X# Correct handling of <> on input.
  1766. X#
  1767. X# Revision 1.8  1993/04/23  20:03:17  lmjm
  1768. X# Use own version of library routines before others.
  1769. X#
  1770. X# Revision 1.7  1993/04/23  17:23:40  lmjm
  1771. X# Renamed ftpmail-local-config.pl to ftpmail-config.pl
  1772. X# Made pathnames relative to $ftpmail_dir.
  1773. X# Allow for some leeway in the max_cmds thing.
  1774. X# Look out for $ftpmail_response in the headers.
  1775. X# Fail if no reply_to in the headers.
  1776. X# Keep copies of input if they have peculiar errors.
  1777. X# If prematute end of input - check if the user is just after help.
  1778. X# Allow for 'reply to email'
  1779. X# Log change of reply_to in the job.
  1780. X# Added corrections from Wolf + his not-auth code..
  1781. X# Correct problem with 'no option' handling.
  1782. X#
  1783. X# Revision 1.6  1993/04/21  10:58:40  lmjm
  1784. X# Smarter mail header parsing by andy.linton@comp.vuw.ac.nz
  1785. X#
  1786. X# Revision 1.5  1993/04/20  20:15:40  lmjm
  1787. X# Added delete option.
  1788. X#
  1789. X# Revision 1.4  1993/04/13  10:34:38  lmjm
  1790. X# Tailored help variables.
  1791. X# Cleanup where necessary.
  1792. X# Allowed for a help command.
  1793. X# Corrected size option.
  1794. X#
  1795. X# Revision 1.3  1993/03/30  20:32:22  lmjm
  1796. X# Must have an ftpmail account whose home directory everything is in.
  1797. X# New -test option that uses /tmp/ftpmail-test
  1798. X# Added better error handling.
  1799. X#
  1800. X# Revision 1.2  1993/03/23  21:40:14  lmjm
  1801. X# Now use ftpmail home directory.
  1802. X# Cleanup tmp files when there are problem
  1803. X#
  1804. X
  1805. X$ftpmail = 'ftpmail';
  1806. X
  1807. X$Revision = '$Revision: 1.13 $';
  1808. X
  1809. Xif( $test ){
  1810. X    $ftpmail_dir = '/tmp/ftpmail-test';
  1811. X}
  1812. Xelse {
  1813. X    # The ftpmail_dir is the home directory of ftpmail.
  1814. X    $ftpmail_dir = (getpwnam( $ftpmail ))[ 7 ];
  1815. X}
  1816. X
  1817. Xif( ! $ftpmail_dir ){
  1818. X    die "No home directory for ftpmail\n";
  1819. X}
  1820. X
  1821. Xif( ! -d $ftpmail_dir ){
  1822. X    die "no such directory as $ftpmail_dir\n";
  1823. X}
  1824. X
  1825. Xchdir( $ftpmail_dir ) || die "cannot chdir to $ftpmail_dir\n";
  1826. X
  1827. X# All the auxillary scripts come from ftpmail's home dir.
  1828. Xunshift( @INC, '.' );
  1829. X
  1830. Xrequire 'config.pl';
  1831. Xrequire 'support.pl';
  1832. X
  1833. X# Don't leave files around writable
  1834. Xumask( 077 );
  1835. X
  1836. X$quenum = time();
  1837. X$qfile = "$quedir/T$quenum.$$";
  1838. X# Lop off the first bit to try and keep the namelen
  1839. X# small enough for system 5.
  1840. X$quenum =~ s/^...//;
  1841. X# If you change this keep the format as: \d+\.\d+
  1842. X$realqfile = "$quedir/$quenum.$$";
  1843. X
  1844. X# No route: a pattern that doesn't match routes
  1845. X$nr = '[^@!%]+';
  1846. X
  1847. X# Copy of incoming data - keep all the header and the first lump of cmds
  1848. X$input_copy = "$incopydir/in$$";
  1849. Xopen( INCOPY, ">$input_copy" ) || &fatal( "Cannot create $input_copy" );
  1850. X$cmd_lines = 0;
  1851. X$in_body = 0;
  1852. X$toomany = 0;
  1853. Xwhile( <> ){
  1854. X    print INCOPY;
  1855. X    if( /^$/ ){
  1856. X        $in_body = 1;
  1857. X        next;
  1858. X    }
  1859. X    if( ! $in_body ){
  1860. X        next;
  1861. X    }
  1862. X    # allow for some leeway in the max_cmds thing.
  1863. X    if( $cmd_lines++ > ($max_cmds +5) ){
  1864. X        $toomany = 1;
  1865. X    }
  1866. X}
  1867. Xclose( INCOPY );
  1868. X
  1869. Xopen( INCOPY, $input_copy ) || &fatal( "Cannot reopen $input_copy" );
  1870. X
  1871. X&read_auth();
  1872. X
  1873. X# Parse the email header to see who sent this message
  1874. X# (This clever bit of code by andy.linton@comp.vuw.ac.nz based on a posting
  1875. X#  by Larry Wall.)
  1876. X$/ = "";            # paragraph mode
  1877. X$* = 1;                # multi-line pattern matching
  1878. X$_ = <INCOPY>;            # read one paragraph
  1879. Xchop( $_ );            # Chop newline ending the paragraph
  1880. X
  1881. X# Should I ignore this?
  1882. Xif( /$ftpmail_response/ ){
  1883. X    &log( "Input contains '$ftpmail_response', ignoring file" );
  1884. X    &cleanexit();
  1885. X}
  1886. X
  1887. Xs/\n[ \t]+/ /g;            # join multi-line entries
  1888. Xs/^reply-to/Reply-To/ig;    # Fix up case on header keys
  1889. Xs/^from/From/ig;
  1890. Xs/^sender/Sender-to/ig;
  1891. X%head = ('PRESTUFF', split( /^(\S+):\s*/ )); # split on entry names
  1892. X$reply_to = $head{ 'Reply-To' } || $head{ 'From' } || $head{ 'Sender' };
  1893. Xchop( $reply_to );        # strip newline
  1894. X
  1895. X$/ = "\n";            # line mode
  1896. X$* = 0;                # single line pattern matching
  1897. X
  1898. Xif( ! $reply_to ){
  1899. X    &log( "No reply_to found in message $input_copy" );
  1900. X    # Force a copy to be kept
  1901. X    $cleanup = 0;
  1902. X    &cleanexit();
  1903. X}
  1904. X
  1905. Xif( $dumb_mailer ){
  1906. X    &dumb_fix_reply_to( $reply_to );
  1907. X}
  1908. X
  1909. Xif( $dont_reply_to && $reply_to =~ /$dont_reply_to/i ){
  1910. X    &log( "reply_to: $reply_to in dont_reply_to pattern: $dont_reply_to, ignoring" );
  1911. X    &cleanexit();
  1912. X}
  1913. X
  1914. Xif( eof ){
  1915. X    # Maybe this is an attempt to get help?
  1916. X    local( $subject ) =  $head{ 'Subject' };
  1917. X    if( $subject =~ /help(\s+french)?/ ){
  1918. X        &mail_back( "help$1" );
  1919. X    }
  1920. X    # No point in going any further
  1921. X    &log( "Premature end of input $input_copy" );
  1922. X    # Force a copy to be kept
  1923. X    $cleanup = 0;
  1924. X    &cleanexit();
  1925. X}
  1926. X
  1927. Xif( $toomany ){
  1928. X    &mail_back( "there are too many commands in your job, the limit is $max_cmds" );
  1929. X}
  1930. X
  1931. X# Anything to actually transfer?
  1932. X$work = 0;
  1933. X
  1934. X# Process lines
  1935. Xwhile( <INCOPY> ){
  1936. X    if( /^\s*$/ || /^#/ ){
  1937. X        next;
  1938. X    }
  1939. X    if( /^$ftpmail_response/ ){
  1940. X        &log( "Input contains '$ftpmail_response', ignoring file" );
  1941. X        &cleanexit();
  1942. X    }
  1943. X    s/^\s*//;
  1944. X    if( /^(reply-to|reply)(\s+to)?(\s+(.+))?/i ){
  1945. X        local( $full, $addr ) = ($3, $4);
  1946. X        if( $full =~ /^\s*$/ ){
  1947. X            &mail_back( "reply-to needs an argument of who to send replies to" );
  1948. X        }
  1949. X        $new_reply_to = $addr;
  1950. X        if( ! $new_reply_to ){
  1951. X            &log( "tried to reset reply_to to nothing, ignored"  );
  1952. X        }
  1953. X        else {
  1954. X            $reply_to = $new_reply_to;
  1955. X            &log( "reply_to reset to $reply_to" );
  1956. X        }
  1957. X        next;
  1958. X    }
  1959. X
  1960. X    if( /^delete\s*(.*)/ ){
  1961. X        $delete = $1;
  1962. X        last;
  1963. X    }
  1964. X
  1965. X    if( /^help(\s+\S+)?/ ){
  1966. X        $help = "help$1";
  1967. X        last;
  1968. X    }
  1969. X    
  1970. X    if( /^(open|connect)(\s+(\S+))?(\s+(\S+))?(\s+(\S+))?/i ){
  1971. X        if( $site ){
  1972. X            &mail_back( "Cannot have multiple open's" );
  1973. X        }
  1974. X        ($site, $user, $pass ) = ($3, $5, $7);
  1975. X        if( $site eq ''){
  1976. X            $site = $default_site;
  1977. X        }
  1978. X        if( $ftp_permitted && $site !~ /$ftp_permitted/ ){
  1979. X            &mail_back( "Cannot ftp to that site only sites matching $ftp_permitted are allowed" );
  1980. X        }
  1981. X        push( @comms, "open $site" );
  1982. X        if( $user eq '' ){
  1983. X            $user = 'anonymous';
  1984. X        }
  1985. X        if( $pass eq '' ){
  1986. X            $pass = $reply_to;
  1987. X        }
  1988. X        if( ! $restricted ){
  1989. X            push( @comms, "user $user" );
  1990. X            push( @comms, "pass $pass" );
  1991. X        }
  1992. X        else {
  1993. X            push( @comms, "user anonymous" );
  1994. X            $pass = "ftpmail/$pass";
  1995. X            $pass =~ s,^ftpmail/-,-ftpmail/,;
  1996. X            push( @comms, "pass $pass" );
  1997. X        }
  1998. X    }
  1999. X    elsif( /^(cd|chdir)(\s+(.+))?/i ){
  2000. X        if( $2 =~ /^\s*$/ ){
  2001. X            &mail_back( "chdir needs an argument of which directory to move to" );
  2002. X        }
  2003. X        push( @comms, "cd $3" );
  2004. X    }
  2005. X    elsif( /^ls\s*(.*)/i ){
  2006. X        push( @comms, "ls $1" );
  2007. X        $work = 1;
  2008. X    }
  2009. X    elsif( /^dir\s*(.*)/i ){
  2010. X        push( @comms, "dir $1" );
  2011. X        $work = 1;
  2012. X    }
  2013. X    elsif( /^get(\s+(.+))?/i ){
  2014. X        if( $1 =~ /^\s*$/ ){
  2015. X            &mail_back( "get needs an argument of which file to get" );
  2016. X        }
  2017. X        push( @comms, "get $2" );
  2018. X        $work = 1;
  2019. X    }
  2020. X    elsif( /^binary/i ){
  2021. X        push( @comms, "mode binary" );
  2022. X    }
  2023. X    elsif( /^ascii/i ){
  2024. X        push( @comms, "mode ascii" );
  2025. X    }
  2026. X    elsif( /^mode(\s+(binary|ascii))?\s*/i ){
  2027. X        if( $1 =~ /^\s*$/ ){
  2028. X            &mail_back( "mode needs an argument of either binary or ascii" );
  2029. X        }
  2030. X        push( @comms, "mode $2" );
  2031. X    }
  2032. X    elsif( /^(compress|gzip|uuencode|btoa|mime)(\s+no)?\s*$/i ){
  2033. X        local( $what, $yea_nay ) = ($1, $2);
  2034. X        local( $no ) = '';
  2035. X        if( $yea_nay =~ /no/i ){
  2036. X            $no = ' no';
  2037. X        }
  2038. X        push( @comms, "$what$no" );
  2039. X    }
  2040. X    elsif( /^(no)\s*(compress|gzip|uuencode|btoa|mime)\s*$/i ){
  2041. X        local( $yea_nay, $what ) = ($1, $2);
  2042. X        local( $no ) = '';
  2043. X        if( $yea_nay =~ /no/i ){
  2044. X            $no = ' no';
  2045. X        }
  2046. X        push( @comms, "$what$no" );
  2047. X    }
  2048. X    elsif( /^force(\s+(compress|gzip|uuencode|btoa|mime)\s*)?$/i ){
  2049. X        local( $full, $what ) = ($1, $2);
  2050. X        if( $full =~ /^\s*$/ ){
  2051. X            &mail_back( "force needs an argument of one of: compress gzip uuencode btoa mime" );
  2052. X        }
  2053. X         push( @comms, "force $what" );
  2054. X    }
  2055. X    elsif( /^size\s+(\d+)\s*(k|b|m)+\s*$/i ){
  2056. X        local( $size ) = $1;
  2057. X        if( $2 =~ /[mM]/ ){
  2058. X            $size *= (1024*1024);
  2059. X        }
  2060. X        elsif( $2 =~ /[bB]/ ){
  2061. X            $size *= 512;
  2062. X        }
  2063. X        elsif( $2 =~ /[kK]/ ){
  2064. X            $size *= 1024;
  2065. X        }
  2066. X        if( $size < $min_size || $size > $max_size ){
  2067. X            $size = $def_max_size;
  2068. X        }
  2069. X        push( @comms, "size $size" );
  2070. X    }
  2071. X    elsif( /^(quit|close|--|==)/i ){
  2072. X        last;
  2073. X    }
  2074. X    else {
  2075. X        $error = "Unrecognised input: $_";
  2076. X        last;
  2077. X    }
  2078. X}
  2079. X
  2080. Xif( !$reply_to ){
  2081. X    &fatal( "Must have a 'reply-to emailaddress'" );
  2082. X}
  2083. X
  2084. X&fix_reply_to();
  2085. X
  2086. Xif( ! &auth( $reply_to ) ){
  2087. X    &mail_back( "reply-to $reply_to not allowed to use this service" );
  2088. X}    
  2089. X
  2090. Xif( $delete ){
  2091. X    # If any problems call &mail_back( "delete fail <err>\n<long err>" )
  2092. X    # and mail_back will generate sensible error messages
  2093. X    if( $delete =~ /^\s*(\d+.\d+)\s*$/ ){
  2094. X        $delete = $1;
  2095. X    }
  2096. X    else {
  2097. X        &mail_back( "delete fail bad argument\nShould be delete <jobid> not: delete $delete" );
  2098. X    }
  2099. X    local( $job ) = "$quedir/$delete";
  2100. X    # Make sure the reply_to's are the same
  2101. X    if( ! open( job, $job ) ){
  2102. X        &mail_back( "delete fail no such job\nCannot delete $delete failed because I couldn't find the job in the queue" );
  2103. X    }
  2104. X    while( <job> ){
  2105. X        if( /^reply-to (.+)$/ ){
  2106. X            $job_reply_to = $1;
  2107. X            last;
  2108. X        }
  2109. X    }
  2110. X    close( job );
  2111. X    if( $job_reply_to ne $reply_to ){
  2112. X        &mail_back( "delete fail not queuer\nYou cannot delete this job $delete as, according to the reply-to, you are not\nThe person who queued it.\n" );
  2113. X    }
  2114. X    # Zap a job and tell them its gone
  2115. X    unlink( $job );
  2116. X    &mail_back( "deleted $delete by user" );
  2117. X}
  2118. Xelsif( $help ){
  2119. X    &mail_back( $help );
  2120. X}
  2121. X
  2122. X
  2123. Xif( !$site ){
  2124. X    &mail_back( "Must have an 'open [site [user [pass]]]'" );
  2125. X}
  2126. X
  2127. Xif( ! $work ){
  2128. X    &mail_back( "Your job contains no get, ls or dir commands so I am ignoring it" );
  2129. X}
  2130. X
  2131. Xif( $error ){
  2132. X    &mail_back( $error );
  2133. X}
  2134. X
  2135. X&log( "queueing entry for $reply_to in $realqfile" );
  2136. X$tries = 0;
  2137. X$whenretry = 0;
  2138. X&write_entry();
  2139. Xrename( $qfile, $realqfile );
  2140. X&mail_back( "ack" );
  2141. X
  2142. Xsub mail_back
  2143. X{
  2144. X    local( $error ) = @_;
  2145. X    local( $show_help ) = 1;
  2146. X    local( $help, $ack, $del, $del_fail );
  2147. X
  2148. X    chop( $error ) if $error =~ /\n$/;
  2149. X    
  2150. X    if( $error =~ /^help(\s+\S+)?/ ){
  2151. X        &log( "mail_back: $reply_to $error" );
  2152. X        $help = $error;
  2153. X        $error = 0;
  2154. X    }
  2155. X    elsif( $error eq 'ack' ){
  2156. X        &log( "mail_back: $reply_to $error" );
  2157. X        $ack = 1;
  2158. X        $error = 0;
  2159. X    }
  2160. X    elsif( $error =~ /^deleted / ){
  2161. X        &log( "mail_back: $reply_to $error" );
  2162. X        $del = $error;
  2163. X        $error = 0;
  2164. X    }
  2165. X    elsif( $error =~ /^(delete fail .*)\n/ ){
  2166. X        &log( "mail_back: $reply_to $1" );
  2167. X        $del_fail = $error;
  2168. X        $error = 0;
  2169. X    }
  2170. X    else {
  2171. X        &log( "mail_back: $reply_to failed to queue because: $error" );
  2172. X    }
  2173. X    
  2174. X    if( $mail_cmd =~ /sendmail/ ){
  2175. X        open( MAIL, "| $mail_cmd " ) ||
  2176. X             &fatal( "Cannot send email" );
  2177. X        print MAIL "To: $reply_to\n";
  2178. X        print MAIL "Subject: $ftpmail_response\n\n";
  2179. X    }
  2180. X    else {
  2181. X        open( MAIL, "| $mail_cmd -s '$ftpmail_response' '$reply_to' >/dev/null 2>&1" ) ||
  2182. X             &fatal( "Cannot send email" );
  2183. X    }
  2184. X    
  2185. X    print MAIL "$ftpmail_response\n";
  2186. X    
  2187. X    &mail_motd();
  2188. X    
  2189. X    if( $error ){
  2190. X        print MAIL "ftpmail has failed to queue your request with an";
  2191. X        print MAIL " error of:\n\t$error\n";
  2192. X        &mail_incopy();
  2193. X    }
  2194. X    elsif( $ack ){
  2195. X        local( $qf ) = $realqfile;
  2196. X        $qf =~ s,.*/([^/]+),$1,;
  2197. X        print MAIL "ftpmail has received the following job from you:\n";
  2198. X        &mail_comms();
  2199. X        print MAIL "\nftpmail has queued your job as: $qf\n";
  2200. X        local( $queuelen ) = &queuelen() - 1;
  2201. X        print MAIL "There are $queuelen jobs ahead of this one in the queue.\n\n";
  2202. X        print MAIL "To remove send a message to $ftpmail_email containing just:\ndelete $qf\n\n";
  2203. X        &mail_incopy();
  2204. X        $show_help = 0;
  2205. X    }
  2206. X    elsif( $del ){
  2207. X        print MAIL "ftpmail has $del\n";
  2208. X        $show_help = 0;
  2209. X    }
  2210. X    elsif( $del_fail ){
  2211. X        print MAIL "ftpmail $del_fail\n";
  2212. X        $show_help = 0;
  2213. X    }
  2214. X    
  2215. X    if( $show_help ){
  2216. X        if( $help =~ /^help(\s+(\S+))/ ){
  2217. X            $hf = "$helpdir/$2";
  2218. X        }
  2219. X        else {
  2220. X            $hf = "$helpdir/help";
  2221. X        }
  2222. X        if( open( HELP, $hf ) ){
  2223. X            while( <HELP> ){
  2224. X                s/\$default_site/$default_site/g;
  2225. X                s/\$help_email/$help_email/g;
  2226. X                s/\$managers_email/$managers_email/g;
  2227. X                s/\$hostname/$hostname/g;
  2228. X                s/\$max_cmds/$max_cmds/g;
  2229. X                s/\$max_size/$max_size/g;
  2230. X                # I use the []'s to prevent RCS from expanding it
  2231. X                s/\$[R]evision/$Revision/g;
  2232. X                print MAIL;
  2233. X            }
  2234. X            close( HELP );
  2235. X        }
  2236. X        else {
  2237. X            print MAIL "Cannot find $help";
  2238. X        }
  2239. X    }
  2240. X
  2241. X    close( MAIL );
  2242. X    &cleanexit();
  2243. X}
  2244. X
  2245. Xsub mail_incopy
  2246. X{
  2247. X    close( INCOPY );
  2248. X    if( ! open( INCOPY, $input_copy ) ){
  2249. X        print MAIL "internal error, cannot reopen input file!";
  2250. X    }
  2251. X    else {
  2252. X        print MAIL "\nYour original input " . ($toomany ? "began" : "was") . ">>\n";
  2253. X        while( <INCOPY> ){
  2254. X            print MAIL;
  2255. X        }
  2256. X        close( INCOPY );
  2257. X        print MAIL "<<End of your input\n";
  2258. X    }
  2259. X}
  2260. X
  2261. X# Read a file of patterns for authorised users
  2262. Xsub read_auth
  2263. X{
  2264. X    if( ! open( auth, $authfile ) ){
  2265. X        &log( "Cannot open $authfile" );
  2266. X        return;
  2267. X    }
  2268. X    while( <auth> ){
  2269. X        next if /^#/;
  2270. X        chop;
  2271. X        if( /^not\s+(.+)$/ ){
  2272. X            $bad_add = $1;
  2273. X            if( /@/ ){
  2274. X                $b = $auth_not_ok;
  2275. X                $auth_not_ok = $b ? "$b|$bad_add" : $bad_add;
  2276. X            }
  2277. X            else {
  2278. X                $auth_host{ $bad_add } = 0;
  2279. X            }
  2280. X        }
  2281. X        elsif( /@/ ){
  2282. X            # user@host pattern 
  2283. X            $a = $auth_ok;
  2284. X            $auth_ok = $a ? "$a|$_" : $_;
  2285. X        }
  2286. X        else {
  2287. X            # hostname
  2288. X            $auth_host{ $_ } = 1;
  2289. X        }
  2290. X    }
  2291. X    close auth;
  2292. X}
  2293. X    
  2294. Xsub auth
  2295. X{
  2296. X    local( $addr ) = @_;
  2297. X    
  2298. X    $addr =~ s/.*<(.*)>.*/$1/;
  2299. X    $addr =~ s/\([^\)]*\)//g;
  2300. X    $addr =~ s/\s+//g;
  2301. X    
  2302. X    if( $addr =~ /^$auth_not_ok$/i ){
  2303. X        return 0;
  2304. X    }
  2305. X    
  2306. X    if( $addr =~ /^$auth_ok$/){
  2307. X        return 1;
  2308. X    }
  2309. X
  2310. X    if( $addr =~ /^($nr)@($nr)$/ ){
  2311. X        local( $user, $host ) = ($1, $2);
  2312. X        return $auth_host{ $host };
  2313. X    }
  2314. X    
  2315. X    return 0;
  2316. X}
  2317. X
  2318. Xsub fix_reply_to
  2319. X{
  2320. X    # Make sure that reply_to doesn't contain any shell escapes
  2321. X    # Since I use it as '$reply_to' then all I have to worry about is
  2322. X    # backprime itself
  2323. X    
  2324. X    # For now just zap them!
  2325. X    $reply_to =~ s/'//g;
  2326. X}
  2327. X
  2328. X# Try to strip away all comments.
  2329. Xsub dumb_fix_reply_to
  2330. X{
  2331. X    $reply_to =~ s/.*<//;
  2332. X    $reply_to =~ s/>.*//;
  2333. X    $reply_to =~ s/\([^\)]+\)//g;
  2334. X}
  2335. X
  2336. Xsub cleanexit
  2337. X{
  2338. X    if( $cleanup ){
  2339. X        unlink( $input_copy );
  2340. X    }
  2341. X    exit( 0 );
  2342. X}
  2343. END_OF_FILE
  2344.   if test 14086 -ne `wc -c <'q.pl'`; then
  2345.     echo shar: \"'q.pl'\" unpacked with wrong size!
  2346.   fi
  2347.   chmod +x 'q.pl'
  2348.   # end of 'q.pl'
  2349. fi
  2350. echo shar: End of archive 1 \(of 2\).
  2351. cp /dev/null ark1isdone
  2352. MISSING=""
  2353. for I in 1 2 ; do
  2354.     if test ! -f ark${I}isdone ; then
  2355.     MISSING="${MISSING} ${I}"
  2356.     fi
  2357. done
  2358. if test "${MISSING}" = "" ; then
  2359.     echo You have unpacked both archives.
  2360.     rm -f ark[1-9]isdone
  2361. else
  2362.     echo You still must unpack the following archives:
  2363.     echo "        " ${MISSING}
  2364. fi
  2365. exit 0
  2366. exit 0 # Just in case...
  2367.