Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
458 lines (381 sloc) 12.8 KB
/* *
* Name: WGET REXX or CURL REXX *
* Date: 2006-Mar-02 *
* This program is part of the CMS Make package. *
* Calls: WEBROVER REXX when it cannot handle a given URL. *
* */
Numeric Digits 20
make_version = "2.0.35"
/* if no other output, attach console */
'STREAMSTATE OUTPUT'
If rc = 4 Then rc = 0
If rc = 8 Then rc = 0
If rc = 12 Then 'ADDPIPE *.OUTPUT: | CONSOLE'
If rc ^= 0 Then Exit rc
verbose = 0
outfile = ""
trans = 1
/* parse command-line and options */
Parse Source cms cmd argu . . arg0 .
Parse Arg args
Parse Var args arg1 .
Do While Left(arg1,1) = "-"
Parse Var args . args
Select
/* shorter option nomenclature may cange between CURL and WGET */
When argu = "CURL" & Abbrev("-s",arg1,2) Then verbose = 0
When argu = "CURL" & Abbrev("-o",arg1,2) Then Parse Var args outfile args
When argu = "WGET" & Abbrev("-q",arg1,2) Then verbose = 0
When argu = "WGET" & Abbrev("-nv",arg1,3) Then verbose = 0
When argu = "WGET" & Abbrev("-O",arg1,2) Then Parse Var args outfile args
When /* both */ Abbrev("-v",arg1,2) Then verbose = 1
When Abbrev("--silent",arg1,8) Then verbose = 0
When Abbrev("--non-verbose",arg1,13) Then verbose = 0
When Abbrev("--verbose",arg1,9) Then verbose = 1
When Abbrev("--binary",arg1,5) Then trans = 0
When Abbrev("--use-binary",arg1,12) Then trans = 0
When Abbrev("--ascii",arg1,5) Then trans = 1
When Abbrev("--use-ascii",arg1,11) Then trans = 1
When Abbrev("-B",arg1,2) Then trans = 1
When Abbrev("--text",arg1,6) Then trans = 1
When Abbrev("--output",arg1,8) Then Parse Var args outfile args
When Abbrev("-h",arg1,2) | Abbrev("--help",arg1,6) Then Do
'CALLPIPE COMMAND HELP CMS' argu '(NOSCREEN' ,
'| NLOCATE 1.10 /DMSHLL355I/ | UNIQ | *.OUTPUT:'
Exit rc
End /* When .. Do */
When Abbrev("--version",arg1,9) Then Do
'CALLPIPE VAR MAKE_VERSION' ,
'| SPEC /CMS Make/ NW W 1 NW /' || argu || '/ NW | *.OUTPUT:'
Exit 0
End /* When .. Do */
When Abbrev("--insecure",arg1,10) ,
| Abbrev("--no-check-certificate",arg1,22) ,
| Abbrev("--cacert",arg1,8) ,
| Abbrev("--capath",arg1,8) ,
| Abbrev("--cert",arg1,6) ,
| Abbrev("-E",arg1,2) ,
| Abbrev("-k",arg1,2) Then Do
Address "COMMAND" 'XMITMSG 14 ARG1 (ERRMSG CALLER URL'
Say "CMS Pipelines needs SSL support"
Exit 24
End
Otherwise Do
Address "COMMAND" 'XMITMSG 3 ARG1 (ERRMSG CALLER URL'
Exit 24
End /* Otherwise Do */
End /* Select */
Parse Var args arg1 .
End /* Do While */
If argu = "CURL" & outfile = "" Then outfile = "-"
/* load standard ASCII <--> EBCDIC translation */
'CALLPIPE STATE POSIX TCPXLBIN'
If rc = 28 Then Address "COMMAND" 'EXEC VMLINK TCPMAINT 592'
'CALLPIPE < POSIX TCPXLBIN | STEM TCP.'
If rc ^= 0 Then Return rc ; a2e = tcp.2 ; e2a = tcp.3
/* get essential config info - like the stack name */
'CALLPIPE < TCPIP DATA | STRIP' ,
'| NLOCATE 1.1 /;/ | STEM TCF.'
If rc ^= 0 Then Return rc
tcp.id = "TCPIP"
Do i = 1 to tcf.0
Parse Upper Var tcf.i cf c1 .
Select
When Abbrev("TCPIPUSERID",cf,6) Then tcp.id = c1
Otherwise nop
End /* Select */
End /* Do For */
/* step through command line list-o-URLs */
Do While args ^= ""
Parse Var args furl args
Parse Var furl mode '://' host '/' file
port = ""
user = ""
pass = ""
If POS('@',host) > 0 Then Parse Var host user '@' host
If POS(':',host) > 0 Then Parse Var host host ':' port
If POS(':',user) > 0 Then Parse Var user user ':' pass
Upper mode
file = "/" || file
If verbose Then Do
Say "PROTOCOL" mode
Say "USERNAME" user
Say "PASSWORD" pass
Say " HOST" host
Say " PORT" port
Say "FILENAME" file
End /* If .. Do */
/* CALL OUT HERE */
Select /* mode */
When mode = "HTTP" Then Parse Value ,
url_http(user,pass,host,port,file,outfile,trans) With rc rs
When mode = "FTP" Then Parse Value ,
url_ftp(user,pass,host,port,file,outfile,trans) With rc rs
Otherwise Do
/* Address "COMMAND" 'XMITMSG 15 MODE (ERRMSG CALLER URL' */
Address "COMMAND" 'XMITMSG 475 MODE (ERRMSG CALLER URL'
/* Address "COMMAND" 'XMITMSG 2481 MODE (ERRMSG CALLER URL' */
Exit 24 ; End
End /* Select */
If rc ^= 0 Then Exit rc
End
Exit
/* ------------------------------------------------------------ URL_HTTP
*/
url_http: Procedure Expose tcp. ; a2e = tcp.2 ; e2a = tcp.3
Parse Arg user,pass,host,port,file,outfile,trans,.
Parse Var file file ";" flag /* look for ";type=A" to mean ASCII */
Upper flag
If flag = "TYPE=A" Then trans = 1
/* add a stream for HTTP header handling if not already there */
Trace Off
'STREAMSTATE INPUT HTTP'
If rc = -4 Then 'ADDSTREAM HTTP'
Trace Normal
If Verify(host,"0123456789.") > 0 Then Do
/* 'CALLPIPE VAR HOST | HOSTBYNAME | VAR ADDR' */
/* a fix from phsiii */
'CALLPIPE VAR HOST | HOSTBYNAME | SPECS w1 1 | VAR ADDR'
If rc ^= 0 Then Return rc
End /* If .. Do */
Else addr = host
If port = "" Then port = 80
If outfile = "" Then outfile = basename(file)
/* determine output to file or stream */
Parse Upper Var outfile fn '.' ft '.' .
If fn = "" Then fn = Userid()
If ft = "" & trans Then ft = "TXT"
If ft = "" Then ft = "BIN"
If fn = "-" Then pipe = "*.OUTPUT:"
Else pipe = 'PAD 1 | >' fn ft 'A'
/* build a proper HTTP request */
req.1 = "GET" file "HTTP/1.0"
req.2 = "Host:" host
req.3 = "Accept: */*"
req.4 = ""
req.0 = 4
/* now drive it either with or without translation */
a2ex = "X" || C2X(a2e)
e2ax = "X" || C2X(e2a)
'ADDPIPE' ,
'*.OUTPUT.HTTP: | TCPCLIENT' addr port ,
'LINGER 7 USERID' tcp.id 'DEBLOCK LINEND 0A' ,
'| *.INPUT.HTTP:'
If rc ^= 0 Then Return rc
/* send the request header then read the response header */
'CALLPIPE (END !) STEM REQ.' ,
'| E2A: XLATE | SPEC 1-* 1 x0D0A N' ,
'| *.OUTPUT.HTTP:',
'! STRLITERAL' e2ax '| E2A:'
If rc ^= 0 Then Return rc
/* consume the response header */
'SELECT INPUT HTTP'
size = 0
i = 0
lm = ""
Do Forever
'PEEKTO RECORD'
If rc ^= 0 Then Leave
Parse Var record record '0D'x
If record = "" Then Leave
i = i + 1 ; h.i = Translate(record,a2e)
Parse Upper Var h.i key val .
If key = "CONTENT-LENGTH:" Then size = val
If key = "LAST-MODIFIED:" Then lm = h.i
'READTO'
End
If rc = 12 Then rc = 0
If rc ^= 0 Then Do
_rc = rc
'SELECT INPUT 0'
Return _rc
End
h.0 = i
'READTO'
/* Say "size indicated is" size */
/* check the HTTP return code */
If h.0 > 0 Then Do
Parse Var h.1 . _rc rs
If _rc = 200 Then _rc = 0
If _rc ^= 0 Then Do
'SELECT INPUT 0'
Return _rc rs
End
End
/* write the content to file or to following stage */
If trans Then 'CALLPIPE (END !) *.INPUT.HTTP:' ,
'| STRIP TRAILING x0D | A2E: XLATE | CHANGE xB0 x5F' ,
'|' pipe ,
'! STRLITERAL' a2ex '| A2E:'
Else 'CALLPIPE *.INPUT.HTTP:' ,
'| BLOCK 512 LINEND 0A' ,
'|' pipe
_rc = rc
'SEVER INPUT' ; 'SEVER OUTPUT'
/* switch back to primary input stream */
'SELECT INPUT 0'
/* 'CALLPIPE STEM H. | > WGET HEAD A' */
/* stamp time on file if a file was written */
If fn ^= "-" & lm ^= "" Then lm = _lm2full(lm)
If fn ^= "-" & lm ^= "" Then Address "COMMAND" 'DMSPLU' fn ft 'A' lm
Return _rc
/* ------------------------------------------------------------- URL_FTP
*/
url_ftp: Procedure Expose tcp. ; a2e = tcp.2 ; e2a = tcp.3
Parse Arg user,pass,host,port,file,outfile,trans,.
Parse Var file file ";" flag /* look for ";type=A" to mean ASCII */
Upper flag
If flag = "TYPE=A" Then trans = 1
If Verify(host,"0123456789.") > 0 Then Do
/* 'CALLPIPE VAR HOST | HOSTBYNAME | VAR ADDR' */
/* a fix from phsiii */
'CALLPIPE VAR HOST | HOSTBYNAME | SPECS w1 1 | VAR ADDR'
If rc ^= 0 Then Return rc
End /* If .. Do */
Else addr = host
If outfile = "" Then outfile = basename(file)
/* determine output to file or stream */
Parse Upper Var outfile fn '.' ft '.' .
If fn = "" Then fn = Userid()
If ft = "" & trans Then ft = "TXT"
If ft = "" Then ft = "BIN"
If fn = "-" Then pipe = "*.OUTPUT:"
Else pipe = ""
/* build a standard FTP request */
If user = "" Then user = "anonymous"
If pass = "" Then pass = Userid()
If port = "" Then port = 21
/* parse server-side file and directory */
file = Reverse(file)
Parse Var file file '/' dir
dir = Reverse(dir)
file = Reverse(file)
temp = "temp.file"
Address "COMMAND" 'MAKEBUF'
Queue user pass
If trans Then Queue "TYPE A"
Else Queue "TYPE I"
Do While dir ^= ""
Parse Var dir dir1 "/" dir
Queue "CD" dir1
End
Queue "GET" file temp "(REPLACE"
Queue "QUIT"
Address "CMS" 'FTP' host port
ftprc = rc
Address "COMMAND" 'DROPBUF'
If ftprc ^= 0 Then Return ftprc
/* pipeline fixup here */
Parse Upper Var temp tfn '.' tft '.' .
If pipe = "" Then Do
Address "CMS" 'RENAME' tfn tft "A" fn ft "="
End ; Else Do
'CALLPIPE <' tfn tft '|' pipe
ftprc = rc
Address "COMMAND" 'ERASE' tfn tft "A"
End
Return ftprc
/* ------------------------------------------------------------ VIAROVER
* For some URLs, just punt to WEBROVER, assuming it is present.
*/
viarover: Procedure Expose tcp. ; a2e = tcp.2 ; e2a = tcp.3
Parse Arg f . , o . , t . , .
/* force WEBROVER into binary mode */
If o = "" Then o = basename(f)
f = f || ";binary"
/* this is a sure way to remove HTTP headers from files retrieved */
/* determine output to file or stream */
Parse Upper Var o fn '.' ft '.' .
If fn = "" Then fn = Userid()
If ft = "" & t Then ft = "TXT"
If ft = "" Then ft = "BIN"
If fn = "-" Then pipe = "*.OUTPUT:"
Else pipe = 'PAD 1 | >' fn ft 'A'
/* now drive it either with or without translation */
If t Then ,
'CALLPIPE (END !) VAR F | WEBROVER | DEBLOCK LINEND 0A' ,
'| STRIP TRAILING x0D | A2E: XLATE | CHANGE xB0 x5F' ,
'|' pipe ,
'! VAR A2E | A2E:'
Else 'CALLPIPE VAR F | WEBROVER |' pipe
Return rc
/* ------------------------------------------------------------ BASENAME
*/
basename: Procedure
Parse Arg file . , .
file = Reverse(file)
Parse Var file file '/' .
Return Reverse(file)
/* ---------------------------------------------------------------------
* Convert Last-Modified HTTP header to FULLDATE format.
*/
_lm2full: Procedure
Parse Arg args
/* parse standard Last-Modified and slice off date and time */
Parse Upper Arg . "," dd mon yyyy time zone . , .
lmdt = dd mon yyyy time
/* convert to POSIX for easier arithmetic */
Address "COMMAND" ,
'PIPE VAR LMDT | DATECONVERT NORMAL POSIX | VAR PDATE'
If rc ^= 0 Then Return ""
/* apply time zone offset */
zdate = C2D(pdate) + tzoffset("S")
zdate = D2C(zdate,8)
/* convert back to FULLDATE and include time */
Address "COMMAND" ,
'PIPE VAR ZDATE | DATECONVERT POSIX FULLDATE TIMEOUT | VAR RS'
If rc ^= 0 Then Return ""
/* slice off fractional time and return usable stamp */
Parse Var rs rd rt .
Parse Var rt rt "." .
Return rd rt
/* ------------------------------------------------------------ TZOFFSET
* Compute timezone offset based on timezone string from 'CP Q TIME'.
* (we probably have a CSL routine to do this ... but maybe not)
*/
tzoffset: Procedure
Parse Upper Arg denom . ',' . , .
Parse Upper Value Diag(08,'QUERY TIME') With . . . tz .
Select /* tz */
When tz = "PST" Then zo = -8
When tz = "PDT" Then zo = -7
When tz = "MST" Then zo = -7
When tz = "MDT" Then zo = -6
When tz = "CST" Then zo = -6
When tz = "CDT" Then zo = -5
When tz = "EST" Then zo = -5
When tz = "EDT" Then zo = -4
When tz = "CET" Then zo = 1
When tz = "CEDT" Then zo = 2
When tz = "CEST" Then zo = 2
When tz = "EET" Then zo = 2
When tz = "EEDT" Then zo = 3
When tz = "EEST" Then zo = 3
When tz = "WET" Then zo = 0
When tz = "WEDT" Then zo = 1
When tz = "WEST" Then zo = 1
/* FEED ME: need more timezones, duh */
When tz = "GMT" Then zo = 0
When tz = "UTC" Then zo = 0
Otherwise zo = 0
End /* Select tz */
denom = Left(denom,1)
Select /* denom */
When denom = "S" Then Return zo * 60 * 60 /* offset in seconds */
When denom = "M" Then Return zo * 60 /* offset in minutes */
Otherwise Return zo
End /* Select denom */
/*
* There are many more options defined for 'curl' and 'wget' than this
* implementation can support. Some which we should support soon are:
*
* --connect-timeout SECONDS Maximum time allowed for connection
* --ftp-pasv Use PASV/EPSV instead of PORT
* -d, --data DATA HTTP POST data
* -G, --get Send the -d data with a HTTP GET
* --data-ascii DATA HTTP POST ASCII data
* --data-binary DATA HTTP POST binary data
* --data-urlencode DATA HTTP POST data url encoded
* -n, --netrc Must read .netrc for user name and password
* -I, --head Show document info only
*/