' MYID '

/* REXX : answer HTTP requests to localhost port 80 with code 404 */ /* This is version 1.9 echoing the complete HTTP request as text */ /* Manual: */ /* Script: */ /* Usage : HTTPD404 [n] [> logfile][2>&1] */ /* Without argument (or n=0) HTTPD404 echoes requests at port 80 */ /* of 127.0.0.1 (localhost). */ /* With n > 0 HPPD404 answers requests at any IP of your system */ /* (INADDR_ANY) using a queue of n requests in SockListen. */ HOST = 'xyzzy.dnsalias.org' /* maybe replace your host */ PAGE = 'purl.net/xyzzy/httpd404.htm' /* and a real home page */ signal on novalue name TFAIL ; signal on syntax name TFAIL signal on failure name TFAIL ; signal on halt name TFAIL MYID = 'HTTPD404.CMD/1.9' /* id. in title and server */ EOL = x2c( 0A ) ; CRLF = x2c( 0D ) || EOL EXPO = 'TSOCK TWAIT MYID EOL CRLF' HEAD = '' MYID '

' || CRLF
   TAIL = '

' || CRLF parse arg TEXT ; TEMP = 1 ; ECHO = 'INADDR_ANY' select when TEXT = '' | TEXT = 0 then ECHO = '127.0.0.1' when datatype( TEXT, 'w' ) then TEMP = TEXT otherwise say 'error:' TEXT ; parse source . . TEXT say 'usage:' TEXT '0 => localhost 127.0.0.1 queue = 1' say 'or :' TEXT '1 => INADDR_ANY port 80, queue = 1' say 'or :' TEXT 'n => INADDR_ANY with queue = n > 1' exit 1 end if TBIND( 80, TEMP, ECHO ) then exit TFAIL() TIME = left( date( 'W' ), 3 ) || ',' date() time() say '---' TIME '---' MYID ECHO '(use ^C to abort)' call RXLOG 7, MYID || ':' ECHO 'started' signal on HALT name ABORT do while TWAIT() = 0 TIME = left( date( 'W' ), 3 ) || ',' date() time() PEER = TPEER() GETH = '' GETU = '' say '---' TIME '---' PEER N = SockRecv( TSOCK, 'TEXT', 2000 ) if N <= 0 then TEXT = '' if N = 2000 then call SockShutDown TSOCK, 0 ECHO = HEAD || TEXT || TAIL /* HTTP 404 document: echo */ parse var TEXT METH URL CODE (CRLF) TEXT TEMP = strip( METH URL CODE ) if 80 <= length( TEMP ) then TEMP = left( TEMP, 75 ) '...' say TEMP /* truncate script kiddies */ select when CODE = '' & METH = 'GET' then nop when CODE = '' then CODE = 400 when METH = 'POST' then CODE = 501 when METH = 'OPTIONS' then CODE = 501 when METH = 'TRACE' then CODE = 501 when METH = 'PUT' then CODE = 501 when METH = 'DELETE' then CODE = 501 when METH = 'CONNECT' then CODE = 501 when METH <> 'GET' & METH <> 'HEAD' then CODE = 400 when abbrev( CODE, 'HTTP/' ) = 0 then CODE = 404 otherwise do until TEXT = '' parse var TEXT LINE (CRLF) TEXT TEMP = translate( LINE ) select when TEMP = '' then leave when abbrev( TEMP, 'HOST:' ) then GETH = strip( substr( LINE, 6 )) when abbrev( TEMP, 'USER-AGENT:' ) then GETU = strip( substr( LINE, 12 )) otherwise iterate end say LINE end if CODE = 'HTTP/1.0' | GETH <> '' then CODE = 404 else CODE = 400 /* missing HTTP/1.1 "Host" */ end if CODE = 404 & URL = '/' then do CODE = 403 /* just for fun: forbidden */ TEMP = ( translate( GETH ) = translate( HOST )) if TEMP = 0 & GETH <> '' then do if SockGetHostByName( HOST, 'X.' ) then do if GETH = X.ADDR then TEMP = 1 ; else do TEMP = X.ADDR if SockGetHostByName( GETH, 'X.' ) then TEMP = ( TEMP = X.ADDR ) else TEMP = 0 /* yes, this code doesn't */ end /* match more than one IP */ end end if TEMP then do /* just for fun: redirect */ CODE = 'Location: http://' || PAGE CODE = '302 Found' || CRLF || CODE end end TEXT = 'text/html' /* see below Content-Type: */ if CODE = 404 & URL <> '/' & GETH <> '' then do 1 if SockGetHostByName( GETH, 'X.' ) = 0 then leave if X.ADDR <> 127.0.0.1 | GETH = X.ADDR then leave if translate( GETH ) = 'LOCALHOST' then leave CODE = '200 OK' ECHO = '4749463839610100 0100800000000000' ECHO = ECHO || 'D8BFD82C00000000 010001000002024C' ECHO = x2c( ECHO || '01003B' ) TEXT = 'image/gif' /* replace ad by one pixel */ end /* thistle D8BFD8 (GIF87a) */ select when CODE = 400 then CODE = '400 Bad request' when CODE = 403 then CODE = '403 Forbidden' when CODE = 404 then CODE = '404 Not found' when CODE = 501 then CODE = '501 Method not implemented' otherwise nop end TEMP = TEXT /* text/html or image/gif */ TEXT = 'HTTP/1.0' CODE /* not HTTP/1.1 (bad date) */ TEXT = TEXT || CRLF || 'Date:' TIME TEXT = TEXT || CRLF || 'Server:' MYID TEXT = TEXT || CRLF || 'Connection: close' if METH <> 'HEAD' & CODE <> '' then do TEXT = TEXT || CRLF || 'Content-Type:' TEMP TEXT = TEXT || CRLF || 'Content-Length:' length( ECHO ) TEXT = TEXT || CRLF || CRLF || ECHO end /* no header if simple GET */ else if CODE = '' then TEXT = ECHO else TEXT = TEXT || CRLF || CRLF if TSEND( TEXT ) = 0 then call TSEND else call SockClose TSOCK if TEMP <> 'image/gif' then call RXLOG 6, MYID || ':' PEER if GETU = '' then GETU = METH URL if 80 <= length( GETU ) then GETU = left( GETU, 75 ) '...' if TEMP <> 'image/gif' then call RXLOG 7, MYID || ':' GETU end /* 2 lines better than long line */ ABORT: /* ^C terminates httpd404 daemon */ TIME = left( date( 'W' ), 3 ) || ',' date() time() say '---' TIME '---' MYID 'aborted' call RXLOG 6, MYID || ': aborted' if condition( 'C' ) <> 'HALT' then exit 1 if symbol( 'TSOCK' ) = 'VAR' then call SockClose TSOCK exit sign( SockClose( TWAIT )) /* -------------------------------------------------------------- */ /* Server: RXLOG httpd event + send DGRAM to local Syslog daemon */ /* , (c) F. Ellermann */ RXLOG: procedure expose (EXPO) /* send message to Syslog daemon */ if RxFuncQuery( 'SockLoadFuncs' ) then do call RxFuncAdd 'SockLoadFuncs', 'RXSOCK', 'SockLoadFuncs' call SockLoadFuncs 'N' /* TRAP if RXSOCK.DLL not found */ end parse arg PRI, MSG /* OS/2 syslogd.exe on 127.0.0.1 */ if right( word( MSG, 1 ), 1 ) <> ':' then do parse source . . MON ; MSG = MON || ':' MSG end MSG = left( MSG, min( 2000, length( MSG ))) select /* forcing REXX error if bad PRI */ when 0 <= PRI & PRI < 8 then PRI = '<' || PRI + 160 || '>' when PRI < 192 then PRI = '<' || PRI + 0 || '>' end parse value date() with DAY MON . ; DAY = right( DAY, 2 ) MSG = PRI || MON DAY time() MSG /* DAY format " D"/"DD" */ return DGRAM( 127.0.0.1, 514, MSG, 'MSG_DONTROUTE' ) DGRAM: procedure expose (EXPO) /* sendto host, port, msg, [flg] */ if sign( verify( arg( 1 ), '0.123456789' )) = 0 then do call SockGetHostByAddr arg( 1 ), 'PEER.' if result = 0 then PEER.ADDR = arg( 1 ) end /* support IP without host name, */ else do /* but not host name without IP: */ call SockGetHostByName arg( 1 ), 'PEER.' if result = 0 then return 'unknown' arg( 1 ) '[' h_errno ']' end PEER.PORT = arg( 2 ) ; PEER.FAMILY = 'AF_INET' SOCK = SockSocket( PEER.FAMILY, 'SOCK_DGRAM', 'IPPROTO_UDP' ) if 0 <= SOCK then do if arg( 4, 'e' ) then SENT = SockSendTo( SOCK, arg( 3 ), arg( 4 ), 'PEER.' ) else SENT = SockSendTo( SOCK, arg( 3 ), 'PEER.' ) call SockClose SOCK /* SockClose() won't reset errno */ if 0 <= SENT then do SENT = length( arg( 3 )) - SENT if SENT = 0 then return '' else return 'lost' SENT 'bytes' end /* empty result means no error, */ end /* caller reports error results */ return 'socket error' SockSock_Errno() value( 'errno' ) /* -------------------------------------------------------------- */ /* RXsock.dll interface: TBIND, TWAIT, TPEER, TSEND, TFAIL, RXMSG */ /* Server: TBIND port, TWAIT for client, get TPEER name, */ TBIND: procedure expose (EXPO) /* server: bind socket at port */ if RxFuncQuery( 'SockLoadFuncs' ) then do call RxFuncAdd 'SockLoadFuncs', 'RXSOCK', 'SockLoadFuncs' call SockLoadFuncs 'N' /* TRAP if RXSOCK.DLL not found */ end if datatype( value( 'TWAIT' ), 'w' ) then call SockClose TWAIT PEER.PORT = arg( 1 ) ; PEER.FAMILY = 'AF_INET' if arg( 3, 'e' ) then PEER.ADDR = arg( 3 ) else PEER.ADDR = 'INADDR_ANY' TWAIT = SockSocket( PEER.FAMILY, 'SOCK_STREAM', 'IPPROTO_TCP' ) select when TWAIT < 0 then return TFAIL() when SockBind( TWAIT, 'PEER.' ) <> 0 then return TFAIL() when SockListen( TWAIT, arg( 2 )) < 0 then return TFAIL() otherwise return 0 end /* 1: all potential errors shown */ TWAIT: procedure expose (EXPO) /* server: wait for next client */ if datatype( value( 'TSOCK' ), 'w' ) then call SockClose TSOCK do 10 TSOCK = SockAccept( TWAIT ) ; if 0 <= TSOCK then return 0 end /* next client at TSOCK accepted */ return TFAIL() /* all waiting clients aborted ? */ TPEER: procedure expose (EXPO) /* server: get TSOCK peer name */ PEER.ADDRTYPE = 'AF_INET' ; PEER = 'aborted.by.peer.invalid' if SockGetPeerName( TSOCK, 'PEER.' ) = 0 then PEER = PEER.ADDR else return PEER if SockGetHostByAddr( PEER, 'PEER.' ) then return PEER.NAME else return PEER TSEND: procedure expose (EXPO) /* TCP send complete data block */ if arg( 1, 'e' ) /* 1: any error, 0: sent / close */ then return length( arg( 1 )) <> SockSend( TSOCK, arg( 1 )) else return SockShutDown( TSOCK, 1 ) <> 0 RXMSG: procedure expose (EXPO) /* show error message & return 1 */ parse source . . THIS ; signal on syntax name RXMSG.TRAP call RxMessageBox arg( 1 ), THIS, /**/, 'HAND' ; return 1 RXMSG.TRAP: call SockPSock_Errno arg( 1 ) ; return 1 TFAIL: /* close sockets and handle TRAP */ signal on novalue name TRAP ; signal on syntax name TRAP signal on failure name TRAP ; signal on halt name TRAP TRAP = RXMSG( 'socket error' SockSock_Errno() value( 'errno' )) if symbol( 'TSOCK' ) = 'VAR' then TRAP = SockClose( TSOCK ) if symbol( 'TWAIT' ) = 'VAR' then TRAP = SockClose( TWAIT ) if condition() = '' then return 1 /* drop into normal TRAP handler, 'sigl' + 'result' preserved: */ /* see , (c) F. Ellermann */ 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 1 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 0 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 */