/* OS/2 REXX: update remote FTP directory tree with local files - */ /* requires RXFTP.DLL (probably still available from IBM). */ /* Installation: edit variables HOME (your local directory tree), */ /* HOST.1 (first server), ROOT.1 (root on HOST.1), your LOGIN.1 , */ /* etc. Try FTPSYNCH without argument to get a short usage info. */ /* Maybe create different WPS objects to update different hosts, */ /* FTPSYNCH works as PM or VIO application. CAVEAT, experimental */ /* code, I've only tested four FTP servers. Parsing time stamps */ /* in various formats is a pain and probably still incorrect. */ /* You lose if your ftp server uses timetamps in a local timezone */ /* before your own timezone (e.g. server GMT, client EST). It's */ /* less critical in the opposite direction, some useless updates. */ /* Timestamps are not used to identify new files if the local and */ /* remote file sizes are different. */ /* Orphans (files only existing on the server) can be removed on */ /* demand. Missing remote directories can be created on demand. */ /* Empty remote directories are not yet supported, use FTP.exe to */ /* remove unused directories. */ /* New in version 0.2: Show bytes (in MB) used for remote files. */ /* Ignore NEW files with non-ASCII or special characters in name, */ /* but EXISTING remote files with dubious names are updated. See */ /* also dir2html.cmd */ /* New in version 0.3: Blanks in file names now handled like all */ /* other dubious characters. Workarounds for special characters: */ /* - telnet IAC d2c(255) doesn't work, fix: use doubled d2c(255) */ /* - d2c(255) still not shown in FtpPwd, but that's not essential */ /* - % generally okay, but FtpPut needs %% (probably a RxFTP bug) */ /* New in version 0.4: special /home/test/index.htm hack removed */ /* New in version 0.5: LOG file added (only for added / updated) */ /* New in version 0.6: default time 23:59:59 instead of 00:00:00 */ /* New in version 0.7: use either '.' or '*' depending on FtpSys */ /* New in version 0.8: adjust "this" to "last year" in DIRT() if */ /* current date('s') is before YYYYMMDD, for */ /* FTP 'ls' output formats without a year. */ HOME = 'd:\misc\test\homepage' HOST.1 = 'home.claranet.de' ; LOGIN.1 = 'xyzzy' ROOT.1 = '/' HOST.2 = 'people-ftp.freenet.de' ; LOGIN.2 = 'omniplex' ROOT.2 = '/' HOST.3 = 'localhost' ; LOGIN.3 = 'mirror' ROOT.3 = 'g:/tmp/tmp' /* Version 0.8, see also */ parse arg USER SWORD ; numeric digits 12 signal on novalue name TRAP ; signal on syntax name TRAP signal on failure name TRAP ; signal on halt name TRAP signal on notready name TRAP ; call UTIL 'SysFileTree' OLD = 0 ; ADD = 0 ; NEW = 0 ; LOG.. = length( HOME ) + 2 SIZE = 0 ; SKIP = 0 ; HEAD = 0 ; LOG.2 = ( PROC() < 3 ) CRLF = x2c( 0D0A ) ; drop SYS ; FTPERRNO = 'n/a' EXPO = 'CRLF FTPERRNO SYS LOG. OLD ADD NEW SIZE SKIP HEAD' if RxFuncQuery( 'FtpLoadFuncs' ) then do call RxFuncAdd 'FtpLoadFuncs', 'RXFTP', 'FtpLoadFuncs' if FtpLoadFuncs( 0 ) <> '' then exit TRAP( 'RxFtp' ) end if symbol( 'HOST.USER' ) <> 'VAR' then do parse source . . USER USER = 'usage:' USER 'n password' CRLF || 'where' USER = USER 'n denotes one of the following URLs:' do N = 1 while symbol( 'HOST.N' ) = 'VAR' USER = USER CRLF N 'ftp://' || LOGIN.N || '@' || HOST.N if abbrev( ROOT.N, '/' ) = 0 then USER = USER || '/' USER = USER || ROOT.N end N exit WAIT( USER CRLF || 'using source directory' HOME '' ) end call FtpSetUser HOST.USER, LOGIN.USER, SWORD if result = 1 then call FtpSetBinary 'Binary' if result = 0 then exit TRAP( 'unexpected RxFtp error' ) call FtpSys 'SYS' if symbol( 'SYS' ) <> 'VAR' then do call WAIT 'FtpSys' HOST.USER 'error' FTPERRNO exit 1 end if LOG.2 then say 'FtpSys' SYS select /* use either FtpDir '.' or '*': */ when abbrev( SYS, 'UNIX' ) then SYS = '.' when abbrev( SYS, 'OS/2' ) then SYS = '*' otherwise SYS = '.' if LOG.2 then say "FtpSys unknown, try '-' for FtpDir()" end LOG.1 = XENV( 'TMP' ) || '\ftpsynch.' || right( USER, 3, 0 ) call lineout LOG.1, left( date( 'W' ), 3 ) date() time() HOME N = SUBS( HOME, ROOT.USER, 0 ) if N then USER = HOST.USER 'last FTP error' FTPERRNO else USER = HOST.USER 'ready:' OLD = OLD + ADD + NEW 'files (' || format( SIZE / 1048578, , 1 ) OLD = OLD 'MB),' ADD 'added,' NEW 'updated,' SKIP 'ignored' OLD = USER || CRLF OLD ; call lineout LOG.1, OLD call WAIT OLD ; call lineout LOG.1 exit N /* result 0: okay, 1: any error */ SUBS: procedure expose (EXPO) if FtpChDir( QUOT( arg( 2 ))) <> 0 then do if FtpPwd( 'DIR..' ) <> 0 then return 1 DIR.. = 'FtpPwd' DIR.. CRLF || 'Create subdirectory' arg( 2 ) if OKAY( DIR.. '?' ) = 0 then return 0 if FtpMkDir( QUOT( arg( 2 ))) <> 0 then return 1 if FtpChDir( QUOT( arg( 2 ))) <> 0 then return 1 end if FtpPwd( 'DIR..' ) <> 0 then return 1 SUBS = arg( 1 ) || '\*' if sign( SysFileTree( SUBS, 'SUB', 'DO' )) then drop SUB. do N = 1 to SUB.0 F = lastpos( '\', SUB.N ) ; F = substr( SUB.N, F + 1 ) if SUBS( SUB.N, F, 1 ) then return 1 end N if LOG.2 then say 'FtpPwd' DIR.. if FtpDir( SYS, 'DIR.' ) <> 0 then DIR.0 = 0 if sign( SysFileTree( SUBS, 'SUB', 'FL' )) then drop SUB. do N = 1 to SUB.0 parse var SUB.N DATE.1 FIND SIZE.1 . SUB.N DATE.1 = DATE.1 FIND FILE = substr( SUB.N, 1 + lastpos( '\', SUB.N )) FIND = ' ' || FILE /* the highlight of FTPSYNCH.cmd */ do F = 1 to DIR.0 if HEAD > 0 then do /* if name column already known: */ if substr( DIR.F, HEAD ) == FIND then leave F iterate F end /* else reverse directory match: */ if abbrev( reverse( DIR.F ), reverse( FIND )) then leave F end F if F > DIR.0 then do /* not found: ADD or SKIP a file */ F = datatype( translate( FILE, /**/, '-._', 0 ), 'A' ) if F <= abbrev( FILE, '.' ) then do SKIP = SKIP + 1 /* dubious names added manually */ if LOG.2 then say 'ignore' SUB.N ; iterate N end if FPUT( SUB.N, FILE ) then return 1 ADD = ADD + 1 ; SIZE = SIZE + SIZE.1 ; iterate N end if HEAD = 0 then HEAD = lastpos( FIND, DIR.F ) parse value DIRT( DIR.F ) with SIZE.2 DATE.2 if SIZE.2 = '' | length( DATE.1 ) <> length( DATE.2 ) then return TRAP( 'unrecognized' DIR.F ) DIR.F = '' /* found: update NEW or keep OLD */ if SIZE.1 <> SIZE.2 | DATE.1 > DATE.2 then do if FPUT( SUB.N, FILE, DATE.1 '>' DATE.2 ) then return 1 NEW = NEW + 1 /* different size always updated */ end /* otherwise update any NEW file */ else OLD = OLD + 1 /* if same size don't upload OLD */ SIZE = SIZE + SIZE.1 end N do F = 1 to DIR.0 /* remaining _files_ are orphans */ if abbrev( DIR.F, 'drw' ) then iterate F if abbrev( space( DIR.F ), '0 DIR ' ) then iterate F parse value DIRT( DIR.F ) with SIZE.2 DATE.2 if SIZE.2 = '' then iterate F FILE = substr( DIR.F, 1 + HEAD ) ; N = right( SIZE.2, 10 ) if OKAY( 'erase remote' N DATE.2 FILE '?' ) = 0 then do OLD = OLD + 1 ; SIZE = SIZE + SIZE.2 ; iterate F end if FtpDelete( QUOT( FILE )) <> 0 then if WAIT( 'FtpDelete' FILE 'error' FTPERRNO ) = 0 then return 1 /* else ignoring FtpDelete error */ end F if arg( 3 ) then return 0 <> FtpChDir( '..' ) else return 0 <> FtpLogoff() FPUT: procedure expose (EXPO) /* FtpPut an updated or new file */ parse arg PATH, FILE, REASON /* no REASON if new, else string */ if LOG.2 then if REASON = '' then say 'adding' PATH else say 'update' PATH if FtpPut( PATH, QUOT( FILE, '%' )) <> 0 then return 1 PATH = substr( PATH, LOG.. ) /* remove HOME from PATH in log: */ PATH = PATH copies( ' ', max( 0, 77 - length( PATH REASON ))) call lineout LOG.1, PATH REASON ; return 0 DIRT: procedure expose (EXPO) /* try to guess timestamp & size */ LINE = left( arg( 1 ), HEAD ) ; W = words( LINE ) if W < 4 then return '' ; YEAR = word( LINE, W ) if datatype( YEAR, 'w' ) then TIME = '23:59:59' ; else do TIME = translate( YEAR, ':', '.' ) select when length( TIME ) = 8 then nop when length( TIME ) = 7 then TIME = '0' || TIME when length( TIME ) = 5 then TIME = TIME || ':00' when length( TIME ) = 4 then TIME = '0' || TIME || ':00' otherwise exit TRAP( 'unexpected' TIME 'in' LINE ) end parse value word( LINE, W - 1 ) with MM '-' DD '-' YEAR if DD = '' then YEAR = word( date(), 3 ) ; else do if length( YEAR ) = 2 then YEAR = YEAR + 2000 TIME = YEAR || '-' || MM || '-' || DD TIME DD = word( LINE, W - 2 ) if datatype( DD, 'w' ) then return DD TIME MM = word( LINE, W - 3 ) if datatype( MM, 'w' ) then return MM TIME exit TRAP( 'unrecognized' MM DD 'in' LINE ) end end MM = word( LINE, W - 2 ) DD = 'Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec' DD = wordpos( translate( MM ), translate( DD )) if DD = 0 then exit TRAP( 'unexpected' MM 'in' LINE ) MM = right( DD, 2, 0 ) DD = right( word( LINE, W - 1 ), 2, 0 ) YEAR = YEAR - ( date( 's' ) < ( YEAR || MM || DD )) return word( LINE, W - 3 ) YEAR || '-' || MM || '-' || DD TIME QUOT: procedure expose (EXPO) /* double telnet d2c( 225 ) IAC: */ SRC = arg( 1 ) ; DST = '' ; POS = pos( d2c( 255 ), SRC ) do while POS > 0 DST = DST || left( SRC, POS ) || d2c( 255 ) SRC = substr( SRC, POS + 1 ) ; POS = pos( d2c( 255 ), SRC ) end SRC = DST || SRC ; DST = '' ; POS = pos( arg( 2 ) , SRC ) do while POS > 0 DST = DST || left( SRC, POS ) || arg( 2 ) SRC = substr( SRC, POS + 1 ) ; POS = pos( arg( 2 ) , SRC ) end /* only if FtpPut %% replacing % */ return DST || SRC /* see , (c) F. Ellermann */ XENV: procedure /* DOS REXX portable environment */ parse version ENV . . if ENV = 'REXXSAA' then do parse source ENV . . /* OS/2 REXXSAA: os2environment */ if ENV = 'OS/2' then ENV = 'OS2ENVIRONMENT' else ENV = ENV || 'ENVIRONMENT' end /* DOS REXXSAA: DOSENVIRONMENT */ else ENV = 'ENVIRONMENT' /* REXX/Personal: environment */ select when arg() = 1 then return value( arg( 1 ),/* get */, ENV ) when arg() = 2 then return value( arg( 1 ), arg( 2 ), ENV ) otherwise return abs( /* force REXX error 40 */ ) end WAIT: procedure /* get OKay (or CANCEL) answer: */ KEY = PROC() ; OUT = 'STDERR' select when KEY = 1 then do /* 1 (real) obsolete: here DOS */ parse version KEY . . /* REXX/Personal has no STDERR: */ if KEY <> 'REXXSAA' then OUT = '\dev\con' end when KEY = 3 then do /* 3 (PM) RxMessageBox() output */ parse source KEY ; KEY = centre( KEY, 100 ) /* HACK */ KEY = RxMessageBox( arg( 1 ), KEY, 'OKCANCEL', 'ASTERISK' ) return KEY = 1 | KEY = 6 | KEY = 8 end /* 0 (fullscreen) and 2 (window) */ when KEY < 4 then call UTIL 'SysGetKey' otherwise nop /* 4 (detached) tested in AKEY() */ end call charout OUT, arg( 1 ) || x2c( 7 ) do until c2d( KEY ) <> 0 & c2d( KEY ) <> 224 KEY = AKEY() end call lineout OUT, '' /* hardwiring F3 '=', Alt-F4 'k' */ return KEY <> x2c( 1B ) & KEY <> '=' & KEY <> 'k' OKAY: procedure /* get YES / NO / CANCEL answer: */ KEY = PROC() ; OUT = 'STDERR' YES = x2c( 0D ) || 'Y+1' ; NAY = x2c( 7F ) || 'N-0' AXE = x2c( 1B ) || 'X=k' /* F3 (003D) = / Alt-F4 (006B) k */ select when KEY = 1 then do /* 1 (real) obsolete: here DOS */ parse version KEY . . /* REXX/Personal has no STDERR: */ if KEY <> 'REXXSAA' then OUT = '\dev\con' end when KEY = 3 then do /* 3 (PM) RxMessageBox() output */ parse source KEY ; KEY = centre( KEY, 100 ) /* HACK */ KEY = RxMessageBox( arg( 1 ), KEY, 'YESNOCANCEL', 'QUERY' ) if KEY = 6 | KEY = 7 then return 7 - KEY ; else exit KEY end when KEY < 4 then call UTIL 'SysGetKey' otherwise nop /* 4 (detached) tested in AKEY() */ end call charout OUT, arg( 1 ) || ': ' do until sign( pos( KEY, 'YNX' )) call charout OUT, x2c( 7 ) ; KEY = translate( AKEY()) if pos( KEY, AXE ) > 0 then KEY = 'X' if pos( KEY, NAY ) > 0 then KEY = 'N' if pos( KEY, YES ) > 0 then KEY = 'Y' end call lineout OUT, KEY ; if KEY = 'Y' then return 1 if KEY = 'N' then return 0 ; exit 2 AKEY: procedure /* keyboard char. input function */ KEY = PROC() if KEY == 4 then return x2c( 1B ) /* 4: detached */ if KEY <> 1 then return SysGetKey( 'NoEcho' ) parse version KEY . . /* 1: DOS REXX */ if KEY == 'REXXSAA' then return RxGetKey( 'NoEcho' ) else return right( INKEY(), 1 ) PROC: procedure /* determine OS/2 process types: */ parse source OS . /* 0: full screen, 1: real mode, */ if OS = 'OS/2' then do /* 2: window, 3: PM, 4: detached */ call UTIL 'SysProcessType' ; return SysProcessType() end return OS <> 'WindowsNT' /* fake 0: NT, 1: DOS or unknown */ UTIL: procedure /* load necessary RexxUtil entry */ if RxFuncQuery( arg( 1 )) then if RxFuncAdd( arg( 1 ), 'RexxUtil', arg( 1 )) then exit TRAP( "can't add RexxUtil" arg( 1 )) return 0 TRAP: /* select REXX exception handler */ call trace 'O' ; trace N /* don't trace interactive */ parse source TRAP /* source on separate line */ TRAP = x2c( 0D ) || right( '+++', 10 ) TRAP || x2c( 0D0A ) TRAP = TRAP || right( '+++', 10 ) /* = standard trace prefix */ TRAP = TRAP strip( condition( 'c' ) 'trap:' condition( 'd' )) select when wordpos( condition( 'c' ), 'ERROR FAILURE' ) > 0 then do if condition( 'd' ) > '' /* need an additional line */ then TRAP = TRAP || x2c( 0D0A ) || right( '+++', 10 ) TRAP = TRAP '(RC' rc || ')' /* any system error codes */ if condition( 'c' ) = 'FAILURE' then rc = -3 end when wordpos( condition( 'c' ), 'HALT SYNTAX' ) > 0 then do if condition( 'c' ) = 'HALT' then rc = 4 if condition( 'd' ) > '' & condition( 'd' ) <> rc then do if condition( 'd' ) <> errortext( rc ) then do TRAP = TRAP || x2c( 0D0A ) || right( '+++', 10 ) TRAP = TRAP errortext( rc ) end /* future condition( 'd' ) */ end /* may use errortext( rc ) */ else TRAP = TRAP errortext( rc ) rc = -rc /* rc < 0: REXX error code */ end when condition( 'c' ) = 'NOVALUE' then rc = -2 /* dubious */ when condition( 'c' ) = 'NOTREADY' then rc = -1 /* dubious */ otherwise /* force non-zero whole rc */ if datatype( value( 'RC' ), 'W' ) = 0 then rc = 1 if rc = 0 then rc = 1 if condition() = '' then TRAP = TRAP arg( 1 ) end /* direct: TRAP( message ) */ TRAP = TRAP || x2c( 0D0A ) || format( sigl, 6 ) signal on syntax name TRAP.SIGL /* throw syntax error 3... */ if 0 < sigl & sigl <= sourceline() /* if no handle for source */ then TRAP = TRAP '*-*' strip( sourceline( sigl )) else TRAP = TRAP '+++ (source line unavailable)' TRAP.SIGL: /* ...catch syntax error 3 */ if abbrev( right( TRAP, 2 + 6 ), x2c( 0D0A )) then do TRAP = TRAP '+++ (source line unreadable)' ; rc = -rc end select when 0 then do /* in pipes STDERR: output */ parse version TRAP.REXX /* REXX/Personal: \dev\con */ if abbrev( TRAP.REXX, 'REXXSAA ' ) | /**/ , 6 <= word( TRAP.REXX, 2 ) then TRAP.REXX = 'STDERR' else TRAP.REXX = '\dev\con' signal on syntax name TRAP.FAIL call lineout TRAP.REXX , TRAP /* fails if no more handle */ end when 1 then do /* OS/2 PM or ooREXX on NT */ signal on syntax name TRAP.FAIL call RxMessageBox translate( TRAP, ' ', x2c( 0D )), /**/ , 'Trap' time(),, 'ERROR' end otherwise say TRAP ; trace ?L /* interactive Label trace */ end if condition() = 'SIGNAL' then signal TRAP.EXIT TRAP.CALL: return rc /* continue after CALL ON */ TRAP.FAIL: say TRAP ; rc = 0 - rc /* force TRAP error output */ TRAP.EXIT: exit rc /* exit for any SIGNAL ON */