/* MAILABLE EXEC -- See HELP at bottom (or issue MAILABLE ?) Copyright (c) Phil Smith III, 1995-2000. May be redistributed freely with this copyright message intact. */ /* Version history: 1.00 -- Primitive version 2.00 -- June 16, 1995 -- Rewritten, smarter (original dates, etc.) 2.01 -- July 11, 1995 -- Eliminate OR bars and NOT signs 2.02 -- September 5, 1995 -- Handle RECFM F output files properly 2.03 -- September 15, 1995 -- Fmode problem with previous update 2.04 -- October 3, 1995 -- Fileid conflicts with 2.02 update 2.05 -- May 1, 1997 -- Handle even more restrictive line lengths 3.00 -- June 1, 1997 -- Handle multiple files, using VMFPLCD 3.01 -- Sept 24, 1998 -- Fix some nits, handle non-SHORTDATE 3.10 -- Sept 28, 1998 -- Shorten lines (avoid probs with mailers) 3.11 -- November 30 1998 -- Drop blank lines (more mailer problems) 3.12 -- November 8 1999 -- Improve warnings when file already exists 4.00 -- January 2000 -- Make self-extracting MAILABLEs 4.10 -- June 2002 -- Add FILELIST, README options; avoid use of "@" 4.11 -- August 2002 -- Improve some error handling; PACK the VMFPLCD 4.12 -- August 2002 -- Handle different output blocksize better 4.13 -- September 2002 -- Remove any use of OR bar 4.14 -- September 2002 -- Fix problem with datestamps 4.15 -- October 31, 2002 -- Fix syntax error on bad command The characters to avoid are: and & X'50' or | X'4F' not ^ X'5F' cent ¢ X'4A' */ address command /* Make sure this is first line of EXEC!!! */ signal on NoValue /* Hygiene */ signal on Syntax /* Hygiene */ version = '4.15' /* Version of this program */ vdate = 'October 31, 2002' /* Date of this version */ pipecmd = 'PIPE' /* Default to PIPE, not PIPEDEMO */ replace = 0 /* Don't replace by default */ quiet = 0 /* Don't be quiet by default */ stack = 0 /* Don't stack by default */ filelist = 0 /* Input not filelist by default */ doreadme = 1 /* Do README if specified by default */ if symbol('README') <> 'VAR' then /* If this isn't set yet... */ readme = '' /* ...then clear it (may be set in EXTRACT mode) */ 'EXECSTAT VMFPLCD EXEC' if rc > 4 then signal NoPLCD parse source . . ename etype emode . /* Get our info */ if emode = '*' then signal Loaded parse version rexxversion . if rexxversion <> 'REXX370' then signal Compiled if symbol('FUNCTION') = 'VAR' then do /* Set if self-extractor */ parse value ename etype emode with ifn ift ifm ofn oft arg rc ofm extra '(' options ')' if rc <> '' then function = rc /* Overrode default function */ if abbrev('EXTRACT', function, 2) then function = 'UNDO' end else do function = 'MAKE' arg ifn ift ifm ofn oft ofm extra '(' options ')' if ift = '' then signal Help if ifn = '?' then signal Help end if function = '?' then signal Help if extra <> '' then signal Extra if ifm = '' then ifm = 'A' if ofn = '=' then ofn = '' if oft = '=' then oft = '' if ofm = '=' then ofm = '' if (ofn oft ofm) = (ifn ift ifm) then signal Same 'ESTATE' ifn ift ifm /* Input file even exist? */ if rc <> 0 then signal BadFile /* Nope, bad news */ 'PIPE (name MailableQCMSLvl stagesep +)' , 'command QUERY CMSLEVEL +' , 'specs w3 1 +' , 'specs ws , w1 1 +' , 'var dateformat' if datatype(dateformat, 'W') & dateformat > 12 then dateformat = 'SHORTDATE' /* Recipient might not have DATEFORMAT */ else dateformat = '' do while options <> '' parse var options option options select when abbrev('UNMAILABLE', option, 2) then function = 'UNDO' when abbrev('EXTRACT', option, 2) then function = 'UNDO' when abbrev('MAILABLE', option, 2) then function = 'MAKE' when abbrev('LISTFILES', option, 1) then function = 'LIST' when abbrev('REPLACE', option, 3) then replace = 1 when abbrev('NOREPLACE', option, 5) then replace = 0 when abbrev('QUIET', option, 3) then quiet = 1 when abbrev('STACK', option, 3) then stack = 1 when abbrev('DEBUG', option, 3) then pipecmd = 'EXEC PIPEDEMO' when abbrev('NODEBUG', option, 5) then pipecmd = 'PIPE' when abbrev('FILELIST', option, 5) then filelist = 1 when abbrev('NOREADME', option, 6) then doreadme = 0 when abbrev('README', option, 4) then do parse var options readme rc options if rc = '' then rc = 'FILE' readme = readme rc end otherwise signal BadOption end end if function <> 'MAKE' & filelist then signal BadOption multiple = translate(ifn ift, ' ', '*%') <> (ifn ift) /* Multi? */ if multiple & function <> 'MAKE' then signal Multiple /* Error */ if wordpos(function, 'MAKE UNDO') = 0 then signal Listfiles ofnx = ofn /* Save output filename as specified */ oftx = oft /* Save output filetype as specified */ ofmx = ofm /* Save output filemode as specified */ if ofn = '' then do /* If no output fn, default */ if translate(ifn, ' ', '%*') <> ifn then ofn = 'MAILABLE' else ofn = ifn /* No wildcards, use input fn */ end if oft = '' then select /* No output ft, default per function */ when function = 'MAKE' then oft = 'MAILABLE' /* If making */ otherwise oft = 'CMSUT1' /* If unmaking MAILable */ end if pipecmd = 'EXEC PIPEDEMO' then do /* If DEBUG */ 'EXECSTAT PIPEDEMO EXEC' /* Make sure PIPEDEMO EXEC exists */ if rc > 4 then signal NoDebug /* If not, error time */ end 'CMDCALL VALIDATE' ofn oft ofm /* Validate the output fileid */ if rc <> 0 then exit rc /* No good, error time */ 'ESTATE * *' ofm /* See if output disk empty */ if rc <> 28 then do /* If disk not empty, check R/W status */ 'ESTATEW * *' ofm /* See if output disk R/W */ if rc = 28 then signal NotRW /* Not R/W, error */ end 'PIPE (name MailableQWorkFM stagesep + endchar ?)' , 'command QUERY DISK R/W +' , /* List R/W disks */ 'drop 1 +' , /* Lose the header */ 'specs 13.1 1 +' , /* Just get the filemodes */ 'find: strfind <'left(ifm, 1)'< +' , /* Look for specified FM */ 'rejoin: faninany +' , /* Bring back in other modes */ 'take 1 +' , /* Take whatever the first one is (IFM or other) */ 'var wfm' , /* And save it */ '?' , 'find: +' , /* All but IFM come here */ 'rejoin:' /* And go back in, perhaps after IFM */ if symbol('WFM') <> 'VAR' then signal NoRW if ofm = '' then ofm = wfm /* If no output fm, default to work */ if function = 'MAKE' & filelist then 'PIPE (name MailableFList stagesep + endchar ?)' , '+ <' ifn ift ifm , '+ strnfind <*<' , '+ locate 1' , '+ change /&1//' , '+ change /&2//' , '+ dup: fanout' , '+ specs 0 then signal BadFile if file.0 = 0 then signal BadFile pfile = ifn ift ifm /* Remember input fileid for piping */ if function = 'MAKE' then do 'ESTATEW' ofn oft ofm /* See if the output already exists */ if rc = 0 & replace = 0 then signal Already /* Error if no REP */ 'ERASE MAILABLE CMSUT2' wfm 'ERASE' ofn oft ofm 'EXEC VMFPLCD RST ENV= MAILABLE CMSUT2' wfm /* Reset */ if rc <> 0 then signal BadPLCD 'PIPE (name MailablePlDump stagesep +)' , 'stem file. +' , 'specs 0 then signal BadPLCD pfile = 'MAILABLE CMSUT2' wfm /* Remember that for piping */ 'PIPE (name MailableMakeLM stagesep +)' , 'stem dump. +' , 'specs '' then do /* Do README ... */ 'PIPE (name MailableQReadme stagesep +)' , '+ stem dump.' , '+ spec w1 1 w2 nw' , '+ pick 1-* == <'readme'<' , '+ count lines' , '+ var found' if found = 0 then signal NoReadme makemagic = makemagic''c2x(';readme='readme) /* Add it */ end cmd.make = '(endchar ? stagesep + name Mailable)' , '<' ename 'EXEC * +' , 'header: frtarget locate
MAILABLE CMSUT1' left(ofm, 1), '?' , 'normal: +' , 'rejoin:' , '?' , 'header: +' , 'preface strliteral x'makemagic '+' , 'rejoin:' , '?' , '<' pfile '+' , 'pack +' , /* PACK the mailable before hexifying it */ 'specs 1-* c2x 1 +' , 'block 64 string MAILABLE CMSUT1' left(ofm, 1), /* Write VMFPLCD file out */ '?', 'a: +' , /* Envelope (headers and trailers) come here */ 'fenv: fanout +' , /* Send away to verify that envelope found */ 'b: strfind <>>< +' , /* Extract file lines */ 'ffiles: fanout +' , /* Send away to verify that files found */ 'specs 3-* 1 +' , 'stem file.', '?', 'b: +' , 'c: strfind <'copies('-', 8)'M-A-I-L-A-B-L-E--< +' , 'take 1 +' , 'specs 26-* 1 +' , 'var oversion' , '?', 'c: +' , /* Come here to look for trailer line */ 'strfind <'copies('*- ', 10)'< +' , 'count lines +' , 'var tlr' , /* Remember whether we got any or not */ '?', 'fstart: +' , 'count lines +' , 'var fstart' , '?', 'fbody: +' , 'count lines +' , 'var fbody' , '?', 'fenv: +' , 'count lines +' , 'var fenv' , '?', 'ffiles: +' , 'count lines +' , 'var ffiles' 'ERASE MAILABLE CMSUT1' ofm /* Delete any possible old output */ pipecmd cmd.function /* Do the PIPE command */ if rc <> 0 then signal Badpipe /* Ouch */ if function = 'UNDO' then do if symbol('OVERSION') <> 'VAR' then signal NoVersion if tlr = 0 then signal NoTrailer oversion = translate(oversion, ' ', '-') parse var oversion oversion ovdate if oversion < oversion then signal OldVersion ovdate = strip(ovdate) if (version vdate) <> (oversion ovdate) then do say '** Warning! ** Mailable created with MAILABLE', 'version' oversion 'dated' ovdate';' say ' You are using version' version 'dated', vdate'.' say ' An output file was created, but may be', 'incorrect.' end if symbol('FSTART') <> 'VAR' then signal NoStart if symbol('FBODY') <> 'VAR' then signal NoBody if symbol('FENV') <> 'VAR' then signal NoEnv if symbol('FFILES') <> 'VAR' then signal NoFiles end 'ESTATEW MAILABLE CMSUT1' ofm if rc <> 0 then signal Nofile if function = 'MAKE' then do 'RENAME MAILABLE CMSUT1' ofm ofn oft ofm if rc <> 0 then signal BadRename 'ERASE' pfile /* PLCD envelope */ if quiet = 0 then do if filelist then say file.0 'files listed in' ifn ift ifm , 'made MAILable as self-extracting MAILABLE' ofn oft ofm'.' else say file.0 'files matching' ifn ift ifm , 'made MAILable as self-extracting MAILABLE' ofn oft ofm'.' say 'Rename this to filetype EXEC and run it for a file' , 'list and instructions.' end end else do if replace = 0 then do i = 1 to file.0 'ESTATE' subword(file.i, 1, 2) ofm if rc = 0 then signal Already end 'EXEC VMFPLCD RST ENV= MAILABLE CMSUT1' left(ofm, 1) if rc <> 0 then signal BadPLCD 'EXEC VMFPLCD LOAD * *' left(ofm, 1) '(NOPRINT' if rc <> 0 then signal BadPLCD 'ERASE MAILABLE CMSUT1' ofm 'PIPE (name MailableUndoLM stagesep +)' , 'stem file. +' , 'specs 0 then signal Different /* Two IFs... */ if dumpx.0 > 0 then signal Different /* ...avoid OR bar */ if quiet = 0 then do say file.0 'file(s) extracted from' , ifn ift ifm 'to disk' left(ofm, 1)':' say 'Filename Filetype Fm' , 'Format Lrecl Recs Blocks Date Time' do i = 1 to file.0 say overlay(left(ofm, 1), file.i, 19) end end if stack then do i = 1 to file.0 push overlay(left(ofm, 1), file.i, 19) end if readme <> '' & doreadme then do say '' say 'Displaying "'readme'" as specified by README option...' 'PIPE (name MailableReadme stagesep +)' , '+ <' readme ofm , '+ console' say '' say 'To display this information again, enter "TYPE' , readme ofm'"' end end exit ListFiles: pipecmd '(stagesep + endchar ? name UnMailable)', '<' ifn ift ifm '+' , 'frtarget locate <'copies('-', 8)'M-A-I-L-A-B-L-E--< +' , 'fstart: fanout +' , /* Send away to verify that start found */ 'strip +' , 'specs 1-* 1 / / n +' , /* Make sure trailing blank for deblock */ 'deblock string <==< +' , /* Undo any damage from mailers */ 'strip +' , 'buffer +' , 'sort 1-8 +' , /* Reorder the lines */ 'specs 10-* 1 +' , /* And lose the line numbers */ 'strtolab /'copies('--* ', 10)'/ +' , 'strfind <>>< +' , /* Extract file lines */ 'specs 3-* 1 +' , 'stem file.' if rc <> 0 then signal BadPipe if file.0 = 0 then signal NoList if quiet = 0 then do say ifn ift ifm 'contains' file.0 'file(s):' say 'Filename Filetype Fm Format Lrecl Recs Blocks Date Time' do i=1 to file.0 say file.i end say '' say 'Issue "'ifn 'EXTRACT" to extract to the A-disk; issue' say ' "'ifn 'EXTRACT fm" to extract to the "fm" disk.' end if stack then do i=1 to file.0 push file.i end exit NoReadme: say 'File "'readme'" specified as README but not included in' , 'files to be dumped.' exit 28 NoList: say 'No files found -- file may not be a MAILABLE, or may be' , 'damaged.' exit 100 NoFile: say 'Return code 0 from PIPE command, but no output file found!' exit 100 NoPLCD: say 'VMFPLCD EXEC does not exist. This IBM utility is usually on' , 'the S-disk.' exit rc BadPLCD: say 'Error' rc 'from VMFPLCD EXEC.' exit rc Multiple: say 'Wildcards invalid on input for unMAILABLE call.' exit 32 BadRename: if function = 'MAKE' then say 'Error' rc 'from RENAME MAILABLE CMSUT1' ofm ofn oft ofm else say 'Error' rc 'from RENAME MAILABLE CMSUT1' ofm ofnx oftx ofmx exit rc BadRewrite: say 'Error' rc 'converting output file to RECFM F from RECFM V.' exit rc BadFile: select when filelist then do r = rc 'PIPE (name MailableBadFL stagesep +)' , '+ stem file.' , '+ specs recno 1 w4 12 1-* 200' , '+ pick 13.1 ^== / /' , '+ specs w1 1 200-* 12' , '+ stem file.' do i = 1 to file.0 parse var file.i n file.i say 'Error processing file "'space(in.n)'":' strip(file.i) end rc = r end when rc <> 28 then exit rc /* Message already issued */ otherwise say 'Input file "'ifn ift ifm'" does not exist.' end exit rc Already: if function = 'MAKE' then file.i = ofn oft ofm else file.i = space(subword(file.i, 1, 2)) ofm say 'Output file "'file.i'" already exists -- specify REPlace.' exit 28 NotRW: say 'Output filemode' substr(ofm, 1, 1) 'not accessed R/W.' exit rc NoRW: say 'No R/W disks accessed.' exit 36 BadPipe: say 'Error' rc 'from "PIPE command.' exit rc NoDebug: say 'DEBUG option not valid, PIPEDEMO EXEC not found.' exit 28 Same: say 'Input and output files may not be the same.' exit 28 Different: say 'Input and output file list or attributes do not match!' , 'Contact support.' if filex.0 > 0 then say 'Unmatched input files:' do i = 1 to filex.0 say filex.i end if dumpx.0 > 0 then say 'Unmatched output files:' do i = 1 to dumpx.0 say dumpx.i end exit 1 Loaded: say ename 'cannot be invoked as an EXECLOADed or DCSS-resident' , 'program because' say 'it requires access to program source.' exit 100 Compiled: say ename 'cannot be invoked as a compiled REXX program because' , 'it requires' say 'access to program source.' exit 100 Extra: say 'Invalid parameter "'extra'".' exit 24 NoBody: say 'Error -- MAILABLE body not found. File may be MIME-encoded.' exit 99 NoEnv: say 'Error -- MAILABLE envelope not found. File may be MIME-encoded.' exit 99 NoFiles: say 'Error -- MAILABLE input file list not found.' , 'File may be MIME-encoded.' exit 99 NoStart: say 'Error -- MAILABLE start indicator not found.' , 'File may be MIME-encoded.' exit 99 NoTrailer: say 'Error -- MAILABLE trailer record not found.' , 'File truncated; no files extracted.' exit 99 NoVersion: say 'Error -- MAILABLE version record not found.' , 'File may be MIME-encoded.' exit 99 BadOption: say 'Invalid option "'option'"' exit 24 OldVersion: say 'Error -- file was encoded using MAILABLE version' oversion 'dated' ovdate';' say 'This version of MAILABLE cannot decode these old files.' exit 99 Syntax: signal off syntax badline = sigl sourcel = GetSourceLine(badline) msg = 'SYNTAX ERROR' rc':' errortext(rc) signal DebugLoop NoValue: signal off NoValue badline = sigl varname = condition('D') sourcel = GetSourceLine(badline) msg = 'NOVALUE of "'varname'"' signal DebugLoop DebugLoop: say msg; say 'Line' badline':' sourcel say 'SLEEPing, hit ENTER to continue' address command 'CP SLEEP' say msg; say sourcel say 'Entering interactive trace, type EXIT to end' trace ?r; do forever; nop; end exit 20040 GetSourceLine: arg l line = '' do forever temp = sourceline(l) line = line temp if right(strip(temp), 2) = '5C61'x then if index(temp, '615C'x) > 0 then parse var temp temp '615C'x if right(strip(temp), 1) <> ',' then return line l = l + 1 end Help: say 'MAILABLE Version' version '('vdate')' say '' say 'MAILABLE converts a file to/from a format suitable for', 'sending in email.' say '' say 'Format is: ' , 'MAILABLE ifn ift >>> <( <)> >' say '' say 'where: ifn ift ifm -- Input filespec;', 'default fm = A' say ' ofn oft ofm -- Output fileid (only ofm used', 'if UNMAILABLEing)' say 'Default for output when making MAILABLE is', '"fn MAILABLE fm"; when undoing' say 'a MAILABLE, the fileids are always as sent.' say '' say 'Options are:' say ' Listfiles -- List files bundled in a MAILable (default' , 'for self-extractors)' say ' UNmailable -- Undo effects of making file MAILable' say ' EXtract -- Same as UNMAILABLE' say ' MAilable -- (Usual default, see below) Make file MAILable' say ' REPlace -- Replace any existing output file' say ' NOREPlace -- (Default) Do not replace existing output file' say ' DEBug -- Use PIPEDEMO to show execution' say ' NODEBug -- (Default) Use PIPEs (no PIPEDEMO)' say ' QUIET -- Suppress informational messages' say ' STACK -- Stack fileids on EXTRACT, UNMAILABLE, or LIST' say ' FILEList -- Input is a file containing fileids, not a' , 'file specification' say ' READme fn ft -- Specify a file (which must be part of the' , 'MAILABLE) to be' say ' displayed after an EXTRACT as a guide for' , 'the recipient. This' say ' file is plain text. Fname is required;' , 'ftype default=FILE;' say ' fmode=EXTRACT disk and thus' , 'may not be specified.' say ' NOREADme -- Suppress display of any README information' say '' say 'An input file specification can use LISTFILE-style wildcards' , 'to indicate' say 'that multiple files are to be dumped. With the FILELIST' , 'option, the' say 'input is a list of files; this can be in CMS EXEC format' , '(with &1 &2' say 'preceding each fileid), or just bare fileids; comments ("*")' , 'are allowed.' say '' say 'To undo a MAILABLE, save the mail message in a disk file and' , 'issue:' say '"MAILABLE fn ft fm (UNMAILABLE" against that file.' say '' say 'Alternatively, just strip headers/trailers and name the file' , 'with a filetype' say 'of EXEC and invoke it to undo the files.' say '' say 'If a MAILABLE file is sent in several MAIL files, they' , 'can be collected' say 'in a single disk file and MAILABLE will reassemble the pieces.' say 'Other than the EXEC code at the start, they need not be' , 'collected in order.' say '' say 'MAILABLE requires VMFPLCD EXEC and CMS Pipelines (both are' , 'standard with VM).' say '' say 'Problems/suggestions/cash to mailable@akphs.com'