/* --------------------------------------------------------------- */ /* Publish current directory to an FTP-driven web server */ /* --------------------------------------------------------------- */ /* */ /* Copyright (c) Mike Cowlishaw, 2006-2013. All rights reserved. */ /* Parts Copyright (c) IBM, 2006-2010. */ /* */ /* Permission to use, copy, modify, and distribute this software */ /* for any non-commercial purpose without fee is hereby granted, */ /* provided that the above copyright notice and this permission */ /* notice appear in all copies, and that notice and the date of */ /* any modifications be added to the software. */ /* */ /* This software is provided "as is". No warranties, whether */ /* express, implied, or statutory, including, but not limited to, */ /* implied warranties of merchantability and fitness for a */ /* particular purpose apply to this software. The author shall */ /* not, in any circumstances, be liable for special, incidental, */ /* or consequential damages, for any reason whatsoever. */ /* */ /* --------------------------------------------------------------- */ /* */ /* This updates current directory and (by default) subdirectories. */ /* It is intended that this be called by a 'stub' Rexx program */ /* that provides a simple command-line interface; see */ /* demoPublish.rex for an example. */ /* */ /* Arguments: */ /* */ /* Arg1 is the FTP address of the target top-level directory, */ /* e.g, 'homepages.freds.co.uk/buss' */ /* Arg2 is user and password (separated by ':'), e.g., 'foo:bar' */ /* Arg3 is list of extensions to transfer as text (a string, one */ /* word per extension, e.g., 'html txt asc') */ /* Arg4 is list of extensions to ignore (these types will not be */ /* published), e.g., log bak old */ /* Arg5 is list to send as binary (use '*' to send all not in */ /* the other two lists), e.g., zip exe msi apk jpg */ /* Arg6 is "effective command line": */ /* verb [flags] */ /* where 'verb' is a (required) pseudonym and 'flags' may */ /* be any (or none) of the user flags/keywords: */ /* clean - delete server files not found in the */ /* curent directory */ /* first - update first difference only */ /* force - force update (rewrite) of all files */ /* from name - skip creates and updates until the file */ /* matching 'name' is reached */ /* logfile file - set the (qualified) name for FTP log */ /* to 'file' */ /* noisy - display FTP commands during run */ /* nolog - do not write FTP trace log */ /* nopublog - do not write publish timestamp log */ /* only name - publish just the one file 'name' */ /* top - update top-level directory only */ /* trace - switch on Rexx (debug) tracing */ /* help, /?, ?, -? -- display help */ /* e.g., sgpublish clean noisy */ /* 'name' or 'file' cannot contain blanks [sorry] */ /* Arg7 is directory to start in (unchanged if not given or '') */ /* [fully qualified, as from directory() call] */ /* Arg8 is notification list; any number of service assignments */ /* of the form service=data, where data depend on the */ /* service; only a summary message is sent, not page/file */ /* details. */ /* Supported services and data formats: */ /* none */ /* No longer supported: */ /* twitter=user:password [requires sendtwit.rex] */ /* */ /* returns '' if OK, non-empty message if a problem */ /* */ /* ::requires "rxftp.cls" */ /* --------------------------------------------------------------- */ -- 2006.03.23 Initial derived from sgpublish, demonpublish, www2publish -- 2007.03.15 Add total size count -- 2007.04.30 Convert to use RxFtp class (ooRexx) & Linuxify -- 2007.10.30 Add HTML check (warning) for img without alt or size -- 2008.01.20 Log to m: preferably (on Windows) -- 2009.04.0x Add from, first, and only options -- 2009.07.12 Add start directory arg -- 2009.07.16 Add logfile option -- 2009.11.27 Add notifications option -- 2013.05.07 Review and cleanup parse arg server'/'where, user':'password,, textTypes, ignoretypes, binarytypes,, command flags, startdir, notifications signal on novalue delim='\' -- filesystem delimiter parse upper source os . if left(os, 3)\='WIN' then delim='/' help=0 -- display help text clean=0 -- delete unmatched files first=0 -- update first difference only fromname='' -- name to start from skipping=0 -- set when skippng creates and updates force=0 -- force all files to be updated top=0 -- 1=top level only trace=0 -- turn on Rexx tracing noisy=0 -- turn on FTP command tracing pubfile='publish.log' -- where to log publish timestamps created=0 -- counts updated=0 -- .. ignored=0 -- .. deleted=0 -- .. total=0 -- .. indent=0 -- nesting indication totalsize=0 -- total size of files (calculated locally) logging=1 -- log to file loggedon=0 -- 1 if session needs logoff logpub=1 -- write publish timestamps logname=command'.log' -- default log name if delim='\' then do -- use m: disk if available, otherwise c: if exists('m:\web') then logdisk='m' else logdisk='c' logroot=logdisk':\' -- where to log FTP trace end else -- *x logroot='~/' -- where to log FTP trace logfile=logroot||logname -- default log place shared='session server user password logfile logging rc clean force top trace', 'created updated ignored deleted total today thisbase months indent', 'binarytypes texttypes ignoretypes totalsize noisy delim', 'command first fromname skipping loggedon' -- Check parameters rc=0 msg='' do while flags\='' parse var flags flag flags arg=translate(flag) select when arg='CLEAN' then clean=1 when arg='FIRST' then first=1 when arg='FORCE' then force=1 when arg='FROM' then do if fromname\='' then call quit 'FROM or ONLY specified twice' parse var flags fromname flags if fromname='' then call quit 'No FROM name specified' say 'Skipping creates and updates until:' fromname skipping=1 end when arg='LOGFILE' then do parse var flags logfile flags if logfile='' then call quit 'No LOGFILE name specified' say 'Logging to' logfile end when arg='NOLOG' then logging=0 when arg='NOPUBLOG' then logpub=0 when arg='TRACE' then trace=1 when arg='NOISY' then noisy=1 when arg='ONLY' then do -- same as FIRST FROM name if fromname\='' then call quit 'FROM or ONLY specified twice' parse var flags fromname flags if fromname='' then call quit 'No ONLY name specified' say 'Updating or creating only:' fromname skipping=1 first=1 end when arg='TOP' then top=1 when arg='?' then help=1 when arg='/?' then help=1 when arg='-?' then help=1 when arg='HELP' then help=1 otherwise msg='Unknown parameter:' flag say msg say '' help=1 rc=-1 end end -- do while flags -- Display help and exit if asked for if help then call help msg -- check vitals if server='' then call quit 'No server specified' if where='' then call quit 'No path specified' if user='' then call quit 'No user specified' if password='' then call quit 'No password specified' -- Date constants months='Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec' parse value date('s') with thisyyyy +4 thismm +2 thisdd +2 -- say thisyyyy':'thismm':'thisdd today = (thismm-1)*31 + thisdd thisbase=thisyyyy*372+today -- pseudo base for today -- check and set local starting directory if startdir\='' then do if \isdir(startdir) then call quit 'Invalid starting directory:' startdir call directory startdir say 'Using directory:' directory() end topdir=directory() -- remember where started -- Create an FTP session object session=.rxftp~new() -- Start logging and/or tracing if noisy then rc=session~FtpTrace -- noisy tracing for debug if logging then do call sysfiledelete logfile rc=session~FtpTraceLog(logfile, 'R') if rc\=0 then say '(Could not write to trace file:' logfile')' end if trace then trace r rc=session~FtpSetUser(server, user, password) if rc=-1 then do ftperrno=session~ftperrno if ftperrno='FTPLOGIN' then call quit 'Could not login user ['user']' if ftperrno='FTPHOST' then call quit 'Could not connect to server ['server']' if ftperrno='FTPCONNECT' then call quit 'Server not responding ['server']' call quit 'Could not set user ['ftperrno']' end say 'FTP to' server 'as' user'...' loggedon=1 -- change to the correct directory at server rc=session~FtpChDir(where) if rc=-1 then do -- directory not exist? say '"'where'" does not exist on the server. Creating...' rc=session~FtpMkDir(where) if rc=-1 then call quit 'Could not create directory "'where'"' rc=session~FtpChDir(where) -- change to new directory if rc=-1 then call quit 'Unexpected error from second FtpChDir' end -- at this point we are in the right [top] place on server and locally here=directory() -- remember where we are s=lastpos(delim, here) dir=substr(here, s+1) if dir='' then call quit 'Unexpected directory() response:' here say ' ...' dir '...' call updatedir '.' -- from here on down (quits if error) call directory here call cleanup -- end FTP session record=thisyyyy':'thismm':'thisdd left(time(),5), 'Created' created', updated' updated',' if clean then record=record 'deleted' deleted',' totalmb=format(totalsize/(1024*1024),,1)'MB' record=record 'ignored' ignored', total' total', size' totalmb say record if logpub then do call lineout pubfile, record call lineout pubfile end if notifications\='' then do top=filespec('n', topdir) m='' if created>0 then m=m 'created' created',' if updated>0 then m=m 'updated' updated',' if deleted>0 then m=m 'deleted' deleted',' if m='' then say '(nothing to notify)' else do m=space(m) -- remove trailing comma; add time & date so not a duplicate m=left(m, length(m)-1) 'at' time() 'on' date('s',,,'-') message='Files in "'top'" have been changed ('m')' do while notifications\='' parse var notifications assign notifications parse var assign service'='data service=upper(service) select when service='FOOBAR' then nop /*** when service='TWITTER' then do parse var data user':' hashtag='#'user'/'top call sendtwit data message hashtag end ***/ otherwise say 'Unknown notification service:' service end end -- notifications loop end -- notification to make end -- notifications exit '' -- (UpdateDir worked) /* ------------------------------------------------------------------ */ /* Display help and exit with message */ /* ------------------------------------------------------------------ */ help: procedure expose (shared) parse arg msg h.1 ='Use as: ' command '[clean] [force] [top]' h.2 ='' h.3 ='This updates the "'server'" server, user "'user'", with' h.4 ='the files from the current directory (which must be known to' h.5 ='the' command 'command).' h.6 ='' h.7 ='Only the filetypes in one of the lists:' h.8 =' binaryTypes:' binarytypes h.9 ='or' h.10=' textTypes:' texttypes h.11='are published; only files that are new, or are newer or same day' h.12='as existing files are published (unless "force" is specified in' h.13='which case all are updated).' h.14='' h.15='If "clean" is specified then files found on the server but not in' h.16='the current directory are deleted.' h.17='If "top" is specified, only the top-level directory is updated.' h.18='' h.19='If "from name" is specified, creates and updates are skipped' h.20='until the named file is found. "first" will stop after the' h.21='first create or update. "only name" is the same as "first from name".' h.22='' h.23='Call with "?", "/?", "-?", or "help" to display this help text' h.24='' h.25='Please see' command'.txt for more details' h.0 =25 -- number of lines say do i=1 to h.0 say h.i end i exit msg /* ------------------------------------------------------------------ */ /* Terminate if error, with rc */ /* ------------------------------------------------------------------ */ quit: procedure expose (shared) say arg(1) '[rc='rc'] -- program exiting.' say 'Please contact MFC for help.' call cleanup exit arg(1) /* ------------------------------------------------------------------ */ /* Cleanup session */ /* ------------------------------------------------------------------ */ cleanup: procedure expose (shared) if symbol('session')\='LIT' then do if loggedon then rc=session~FtpLogOff -- 'quit' to server if logging then rc=session~FtpTraceLogOff -- end logging -- if noisy then rc=session~FtpTrace -- [cannot be switched off] end return /* ------------------------------------------------------------------ */ /* Check an HTML file */ /* ------------------------------------------------------------------ */ checkhtml: procedure expose (shared) parse arg file doc=charin(file, 1, chars(file)) call lineout file -- or put will fail do forever parse var doc '' doc if atts='' then leave -- have an img tag to check up=translate(atts) if pos('SRC=', up)=0 then say '*** with no SRC= in:' file if pos('ALT=', up)=0 then say '*** has no ALT= in:' file else do parse var up 'ALT=' text . if text='""' then say '*** has empty ALT= in:' file end if pos('WIDTH=', up)=0 then say '*** has no WIDTH= in:' file else if pos('HEIGHT=', up)=0 & pos('DEPTH=', up)=0 then say '*** has no HEIGHT= in:' file -- [don't warn about both width and height] end return /* ------------------------------------------------------------------ */ /* Update subdirectory */ /* Arg1 is the name of the subdirectory to update */ /* */ /* This is first called with "subdirectory" name '.' to update the */ /* top level directory, and then calls itself recursively to update */ /* subdirectories (unless TOP is specified) */ /* */ /* Exits directly to Quit if an error. */ /* ------------------------------------------------------------------ */ updatedir: procedure expose (shared) parse arg subdir indent=indent+2 -- formatting para=copies(' ', indent) -- change to correct directory at server and locally if subdir\='.' then do rc=session~FtpChDir(subdir) if rc=-1 then do -- directory not exist? say '"'subdir'" does not exist on the server. Creating...' rc=session~FtpMkDir(subdir) if rc=-1 then call quit 'Could not create directory "'subdir'"' rc=session~FtpChDir(subdir) -- change to new directory if rc=-1 then call quit 'Unexpected error from second sub FtpChDir' subdir end call directory subdir -- locally, too say para'...' subdir '...' end -- We are in the right place. Find out what's there. rc=session~FtpDir('*.*') if rc=-1 then call quit 'Unexpected error from FtpDir *.*' -- if address()='GOSERVE' then say ' Back from FTPDir' -- temp -- note that on some servers we get some spurious blank lines, and -- in one case (old 10quid system) have seen all files listed twice -- Copy oo-response items to there. stem to use old code there.0=session~response~items do i=1 to there.0 there.i=session~response[i] end i if address()='GOSERVE' then 'active read' there.0*50 -- estimate is fine -- parse the files. We are only interested in relative age to the -- nearest day, so we work out 'pseudo ages' based on 32-day months -- say para||there.0 'files...' exist.=0 -- file exists fileage.=372 -- assume age of any surprising file is 1 year (31*12) do f=1 to there.0 parse var there.f flags . . . size mon dd year name if name='' then iterate -- spurious from some servers if left(flags, 1)\='-' then iterate -- ignore directory & messes if pos('->', name)>0 then iterate -- a symbolic link exist.name=1 -- have file -- calculate an approximate age, assuming 31 days/month mm=wordpos(mon, months) -- month name to number if mm=0 then iterate -- use default if \datatype(dd, 'n') then iterate -- .. if dd<1 | dd>31 then iterate -- .. -- the 'year' field will be a time if within a year if \datatype(year, 'n') then do -- is not a year days=today - ((mm-1)*31+dd) -- age in days if days<0 then days=372+days -- [future date] end else days=thisbase-(year*372+(mm-1)*31+dd) fileage.name=days -- save -- say para||name 'is' days 'days old' end f -- now process local files localexist.=0 -- local file exists call sysfiletree '*', 'LOCAL', 'BL' if result\=0 then call quit 'Unexpected SysFileTree error ['result']' -- say para'-----' dir.='' -- delay list for directories dirs=0 -- count of delayed directories do f=1 to local.0 -- say '>>' local.f parse var local.f yyyy'-'mm'-'dd' ' . size flags fullname name=filespec('name', fullname) -- record for later if a directory if left(flags, 2)='-D' then do dirs=dirs+1 dir.dirs=name iterate end -- ignore it if a 'zeroed' or empty file if size=0 then iterate -- ignore it if type not in a list, or no type (extension) d=lastpos('.', name) if d=0 then iterate type=substr(name, d+1) binpos=wordpos(type, binarytypes) ascpos=wordpos(type, texttypes) if binpos=0 & binarytypes\='*' then -- not in binary list .. if ascpos=0 then do -- .. or ascii list ignpos=wordpos(type, ignoretypes) if ignpos=0 then -- worth a warning say para'Ignored:' name '(type ".'type'" not known)' ignored=ignored+1 iterate end /* File is to be sent (created or updated); check it if HTML */ ishtml=(left(translate(type), 3)='HTM') totalsize=totalsize+size -- total eligible files' size if ascpos>0 then mode='Ascii' else mode='Binary' localexist.name=1 total=total+1 if \exist.name then do -- new if skipping then do if translate(fromname)=translate(name) then skipping=0 end if skipping then nop -- say para'Skipped:' name else do if ishtml then call checkhtml name call checksize name rc=session~FtpPut(name, name, mode) if rc=-1 then call quit 'Unexpected error from create FtpPut' name mode say para'Created:' name created=created+1 end end else do -- exists, maybe update -- estimated age of local in days days=thisbase-(yyyy*372+(mm-1)*31+dd) -- say para'Local' name 'is' days 'days old' if days<=fileage.name | force then do if skipping then do if translate(fromname)=translate(name) then skipping=0 end if skipping then nop -- say para'Skipped:' name else do if ishtml then call checkhtml name call checksize name rc=session~FtpPut(name, name, mode) if rc=-1 then call quit 'Unexpected error from update FtpPut' name mode say para'Updated:' name updated=updated+1 end end end if address()='GOSERVE' then 'active sent' size -- still active if first & (created+updated>0) then leave f end f if clean then do -- any deletes? do f=1 to there.0 parse var there.f flags . . . . . . . name if name='' then iterate -- spurious from some servers if left(flags, 1)\='-' then iterate -- ignore directory & messes if pos('->', name)>0 then iterate -- a symbolic link if localexist.name then iterate -- not missing rc=session~FtpDelete(name) if rc=-1 then call quit 'Unexpected error from FtpDelete' name say para'Deleted:' name deleted=deleted+1 if address()='GOSERVE' then 'active sent' length(name) -- estimate is fine end f end -- clean -- now process nested directories, unless top-level only or first -- and completed if \top then if \(first & (created+updated>0)) then do d=1 to dirs call updatedir dir.d -- recursively update from 'name' down end d if subdir\='.' then do -- we went down call directory '..' -- up locally rc=session~FtpChDir('..') -- and remotely if rc=-1 then call quit 'Unexpected error from FtpChDir ".." (parent)' end indent=indent-2 return /* Test whether a name is a directory that exists */ isdir: procedure parse arg dir r=right(dir, 1) if r='/' | r='\' then dir=left(dir, length(dir)-1) opts='BL' -- not subdirs call sysfiletree dir, 'LIST', opts if result\=0 then return result if list.0\=1 then return 0 parse var list.1 date time size flags fullname return pos('D', flags)=2 -- is directory /* Note large file start */ checksize: procedure expose para parse arg name size=stream(name, 'c', 'query size') if size<250000 then return mb=format(size/1024**2,,1) say para'Putting:' name ' ['mb 'MB]' return ::requires "rxftp.cls"