/* REXX single thread TCP/IP identd server / client version 0.8: */ /* source: */ /* usage : RXIDENT 113 [>logfile][2>&1] run as identd server */ /* or : RXIDENT peer-port,local-port ident. connection user */ /* or : RXIDENT 113,host_or_ip ident. ident connection */ signal on novalue name TFAIL ; signal on syntax name TFAIL signal on failure name TFAIL ; signal on halt name TFAIL CRLF = x2c( 0D0A ) ; EXPO = 'TSOCK TWAIT CRLF' EOL = x2c( 0A ) ; parse arg HIS ',' OUR call RxQueue 'Set', RxQueue( 'Create' ) select when HIS = '' then exit USAGE( ) when HIS <> 113 then exit QUERY( HIS || ',' || OUR ) when OUR <> '' then exit QTEST( OUR ) when TBIND( 113, 1 ) then exit QEXIT( 1 ) otherwise LINE = SockGetHostId() 'daemon started, use ^C to abort' say date( 'O' ) TIME() LINE call RXLOG 7, 'rxident:113:' LINE signal on HALT name ABORT end do while TWAIT() = 0 parse value TREAD() with LINE (EOL) LINE = translate( LINE,, CRLF ) TEXT = ':ERROR:INVALID-PORT' ; parse var LINE OUR ',' HIS select when datatype( OUR, 'w' ) = 0 then nop when datatype( HIS, 'w' ) = 0 then nop when 1 > OUR | OUR > 65535 then nop when 1 > HIS | HIS > 65535 then nop otherwise TEXT = value( 'USER',, 'OS2ENVIRONMENT' ) if TEXT = '' then TEXT = ':ERROR:HIDDEN-USER' else TEXT = ':USERID:UNIX:' || TEXT parse value IDENT( HIS || ',' || OUR ) with PORT . if PORT = '' then TEXT = ':ERROR:NO-USER' end LINE = LINE || TEXT TEXT = TPEER() if TSEND( LINE || CRLF ) = 0 then call TSEND say date( 'O' ) TIME() TEXT LINE call RXLOG 6, 'rxident:113:' TEXT LINE end /* continue or drop into ABORT */ ABORT: /* ^C terminates rxident daemon */ LINE = SockGetHostId() 'daemon aborted' say date( 'O' ) TIME() LINE call RXLOG 6, 'rxident:113:' LINE exit QEXIT( condition( 'C' ) <> 'HALT' ) /* -------------------------------------------------------------- */ /* 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 /* -------------------------------------------------------------- */ /* Server: RXLOG ident 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 if SockGetHostByAddr( arg( 1 ), 'PEER.' ) = 0 then do PEER.ADDR = arg( 1 ) ; PEER.HOST = arg( 1 ) end /* support IP without host name: */ end /* SockSendTo() handles bad IP */ else if SockGetHostByName( arg( 1 ), 'PEER.' ) = 0 then return 'unknown host' arg( 1 ) value( 'h_errno' ) 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' ) /* -------------------------------------------------------------- */ /* Client: QUERY existing connection, QTEST own ident connection */ QUERY: procedure expose (EXPO) /* identify existing connection */ parse value IDENT( arg( 1 )) with PORT HOST select when HOST = '' then return QEXIT( 1 ) when TOPEN( HOST, 113 ) then return QEXIT( 1 ) when TSEND( PORT || CRLF ) then return TFAIL() otherwise LINE = TREAD() ; if LINE = '' then return TFAIL() say LINE ; call TSEND ; return QEXIT( 0 ) end QTEST: procedure expose (EXPO) /* identify ident connection */ arg HOST.ADDR ; HOST.FAMILY = 'AF_INET' select when TOPEN( HOST.ADDR, 113 ) then return QEXIT( 1 ) when SockGetSockName( TSOCK, 'HOST.' ) <> 0 then nop when TSEND( '113,' || HOST.PORT || CRLF ) <> 0 then nop otherwise say 'sent to' HOST.ADDR || ':' '113,' || HOST.PORT LINE = TREAD() ; if LINE = '' then return TFAIL() say LINE ; call TSEND ; return QEXIT( 0 ) end return TFAIL() /* -------------------------------------------------------------- */ /* Common: IDENTify connection by ports, USAGE, QEXIT clean-up */ IDENT: procedure expose (EXPO) /* identify connection by ports */ parse arg HIS ',' OUR ; if OUR = '' then return '' address CMD '@( netstat -s | RXQUEUE' RxQueue( 'Get' ) ')' do queued() parse pull . TEXT PEER PORT HOST . if TEXT <> 'STREAM' | HOST = '0.0.0.0' then iterate parse var PORT TEXT '..' PORT ; if PORT = '' then PORT = TEXT parse var PEER TEXT '..' PEER ; if PEER = '' then PEER = TEXT if HIS = PEER & OUR = PORT then do do queued() ; pull ; end return PEER || ',' || PORT HOST end end return '' USAGE: procedure expose (EXPO) /* show usage or error message */ parse source . . THIS TEXT = 'or :' THIS '113 # run as identd' TEXT = 'or :' THIS '113,localhost # selftest' || CRLF || TEXT TEXT = 'usage:' THIS 'his-port,our-port' || CRLF || TEXT say TEXT ; return QEXIT( 1 ) QEXIT: procedure expose (EXPO) /* close sockets and return code */ if symbol( 'TSOCK' ) = 'VAR' then TRAP = SockClose( TSOCK ) if symbol( 'TWAIT' ) = 'VAR' then TRAP = SockClose( TWAIT ) if RxQueue( 'Get' ) <> 'SESSION' then call RxQueue 'Delete', RxQueue( 'Set', 'SESSION' ) return ( 0 <> arg( 1 )) /* 0: okay, 1: any other outcome */ /* -------------------------------------------------------------- */ /* RXsock.dll interface (TOPEN, TREAD, TSEND, TFAIL) + gen. RXMSG */ TOPEN: procedure expose (EXPO) /* TCP connect with HOST 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( 'TSOCK' ), 'w' ) then call SockClose TSOCK if sign( verify( arg( 1 ), '0.123456789' )) = 0 then do if SockGetHostByAddr( arg( 1 ), 'PEER.' ) = 0 then do PEER.ADDR = arg( 1 ) ; PEER.HOST = arg( 1 ) end /* support IP without host name: */ end /* SockConnect() handles bad IP */ else if SockGetHostByName( arg( 1 ), 'PEER.' ) = 0 then return RXMSG( 'unknown host' arg( 1 ) value( 'h_errno' )) PEER.PORT = arg( 2 ) ; PEER.FAMILY = 'AF_INET' TSOCK = SockSocket( PEER.FAMILY, 'SOCK_STREAM', 'IPPROTO_TCP' ) if 0 <= TSOCK then do if SockConnect( TSOCK, 'PEER.' ) = 0 then return 0 end /* 0: okay, connected with TSOCK */ return TFAIL() /* 1: error shown, socket closed */ TREAD: procedure expose (EXPO) /* TCP read line (or data block) */ READ = '' do until N < 2000 | sign( pos( x2c( 0A ), READ )) N = SockRecv( TSOCK, 'DATA', 2000 ) if N > 0 then READ = READ || left( DATA, N ) end return READ 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 RxQueue( 'Get' ) <> 'SESSION' then TRAP = RxQueue( 'Delete', RxQueue( 'Set', 'SESSION' )) 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 */