/*
**       VM TCP/IP Network Archie client
**
**       Transliterated from the MVS ARCHIE client written by
**       Alasdair Grant, University of Cambridge Computer Laboratory
**
**       VM/CMS client by
**       Arthur J. Ecock  (ECKCU@CUNYVM.CUNY.EDU)
*/
Address Command
 
Parse Arg word .
 
/*
** Proposed syntax; code to parse this needs to be added
*/
If word="?" | word="" Then Do
   Say "Syntax: archie word</options>"
   Say "        archie word ( options"
   Say "        archie word <-option>"
   Say "        archie <-option> word"
   Say ""
   Say "word may be a quoted string (with embedded blanks)"
 
   Exit 100
End
 
host = "archie.unl.edu"
/*
**   This is another possible value for "host"
**
**   host = "raquel.doc.ic.ac.uk"
*/
 
/*
**   Option defaults
*/
hits  = 100
match = "S"                  /* Case Insensitive */
 
/*
**  Other values for "match":
**
**  match = "s"                  /* Case Insensitive, Exact Match */
**  match = "C"                  /* Case Sensitive */
**  match = "c"                  /* Case Sensitive, Exact Match */
**  match = "R"                  /* Regular Expression */
**  match = "r"                  /* Regular Expression, Exact Match */
**  match = "="                  /* Exact Match */
*/
 
 
/*
**   Make sure we have the proper version of RXSOCKET
*/
Parse Value Socket('Version') With rc name version date text
If version<2.00 Then Do
   Say "This EXEC requires RXSOCKET Version 2"
   Exit 100
End
 
 
/*
**   EBCDIC character constants
*/
cr       = '0D'x
lf       = '25'x
 
months   = "Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"
 
 
/*
**   Initialize RXSOCKET
*/
Parse Value Socket('Initialize', 'ArchieC') With rc .
If rc^=0 Then Call Error "INITIALIZE"
 
 
/*
**   Request a new socket descriptor (UDP protocol)
*/
Parse Value Socket('Socket', 'AF_INET', 'Sock_Dgram') With rc socket .
If rc^=0 Then Call Error "SOCKET"
 
 
/*
**   Tell RXSOCKET that we want to use non-blocking mode
*/
Parse Value Socket('Ioctl', socket, 'FIONBIO', 'On') With rc .
If rc^=0 Then Call Error "IOCTL"
 
 
/*
**   Send query to host
*/
Parse Value Socket('Resolve', host) With rc hisaddr hisname
If rc^=0 Then Call Error "RESOLVE"
 
Parse Value Socket('GetServByName', 'Prospero-NP') With rc servname servport .
 
name = 'AF_INET' servport hisaddr
 
 
/*
**   Send the archie "query" to the server
*/
header = '090030000100010000'x
 
text   = 'VERSION 1'||lf||'AUTHENTICATOR UNAUTHENTICATED UNKOWN'||lf
text   = text||'DIRECTORY ASCII ARCHIE/MATCH('hits',0,'match')/'word||lf
text   = text ||'LIST ATTRIBUTES COMPONENTS '||lf
query  = header||EC2AC(text)
 
Parse Value Socket('SendTo', socket, query,,name) With rc bytes_out .
If rc^=0 Then Call Error "WRITE"
 
 
/*
**   Loop, reading response and building response buffer
**   (this has to be done piecemeal, since TCP sends arbitrary
**   length packets that need not be terminated by line boundaries)
*/
ack1    = 0
line    = ""
timeout = 5
 
Do Forever
   Parse Value Socket('Select', 'Read' socket, timeout) With result
   Parse Var result rc count "READ" rlist "WRITE" .
   If rc^=0 Then Call Error "SELECT"
 
   If count=0 Then Do
      If timeout<30 Then Do
         Say "** Timed out - retrying..."
 
         Parse Value Socket('SendTo', socket, query,,name) With rc bytes_out .
         If rc^=0 Then Call Error "WRITE"
 
         timeout = timeout * 3
         Iterate
      End
      Else Leave
   End
 
   Parse Value Socket('Recv', socket) With rc bytes_in data
   If rc^=0 Then Call Error "READ"
   If bytes_in=0 Then Leave
 
   h_len = Substr(data,1,1)
   h_len = C2D(h_len)
   If h_len<20 Then Do
/*
**    Older versions of REXX370 (most notably, 3.40) don't support
**    +(var) in "Parse" statements.  Sigh.
**
**    h_len = h_len - 1
**    Parse Var data +1 header +(h_len) data
*/
      header = Substr(data,2,h_len)
      data   = Substr(data,h_len+1)
 
      Parse Var header h_connid +2 h_pktnum +2 h_pkttot +2 h_pktrec +2 h_time +2 .
      h_pktnum = C2D(h_pktnum)
      h_pkttot = C2D(h_pkttot)
      h_pktrec = C2D(h_pktrec)
      h_time   = C2D(h_time)
 
      timeout  = h_time
 
      If ^ack1 Then Do
         Say "Search request accepted by Archie ... Please wait ..."
         Say ""
         ack1 = 1
      End
   End
   Else h_len = 0
 
   If data="" | h_len=bytes_in Then Iterate
 
   data = Substr(data,1,Length(data)-1)
   line = line || AC2EC(data)
 
   If h_pktnum=h_pkttot | h_len<7 Then Leave
End
 
 
 
/*
**   Now split up the response buffer at line boundaries and
**   display the result (in EBCDIC)
*/
complete = 0
 
If line="" Then Do
   Say "** Timed out, no response"
   Call Exit
End
 
Do Forever
   If line="" Then Leave
   Parse Var line data (lf) line
 
   Select
      When Substr(data,1,7)=="LINK L " Then Do
         Parse Var data "LINK L" type name "INTERNET-D" host . dir .
 
         If Substr(dir,1,12)=="ARCHIE/HOST/" Then Do
            dir = Substr(dir,13)
            Parse Var dir host"/"dir
            dir = "/"dir
         End
         If type^="DIRECTORY" Then type = "     FILE"
 
         If complete Then Do
            Say "Host" host
            Say "    Location:" dir
            Say "     " type modes Right(size,10) fdate name
            Say ""
 
            complete = 0
         End
      End
      When Substr(data,1,9)=="LINK-INFO" Then Do
         Parse Var data "LINK-INFO" . attribute . value
 
         If attribute="SIZE" Then size = Word(value,1)
         If attribute="UNIX-MODES" Then modes = value
         If attribute="LAST-MODIFIED" Then Do
            Parse Var value year +4 month +2 day +2 hour +2 minute +2 second +2 zone +1 .
            If zone="Z" Then zone = "GMT"
            If year=Substr(Date('Sorted'),1,4) Then year = Right(hour,2)":"Right(minute,2,'0')
            Else year = year" "
 
            fdate = Word(months,month) Right(day,2) year
         End
 
         complete = 1
      End
      When Substr(data,1,6)=="FILTER" Then Nop
      When Substr(data,1,11)=="OBJECT-INFO" Then Nop
      When Substr(data,1,10)=="NONE-FOUND" Then ,
         Say "** Archie did not find any files matching your request"
      When Substr(data,1,21)=="VERSION-NOT-SUPPORTED" Then ,
         Say "** Archie error: version not supported"
      When Substr(data,1,15)=="NOT-A-DIRECTORY" Then ,
         Say "** Archie error: not a directory"
      When Substr(data,1,10)=="UNRESOLVED" Then ,
         Say "** Archie error: unresolved entries"
      When Substr(data,1,9)=="FORWARDED" Then ,
         Say "** Archie error: no forwarding allowed"
      When Substr(data,1,14)=="NOT-AUTHORIZED" Then ,
         Say "** Archie error: not authorized"
      When Substr(data,1,22)=="FAILURE NOT-AUTHORIZED" Then ,
         Say "** Archie error: request fewer matches, please"
      When Substr(data,1,7)=="FAILURE" Then Do
         Parse Var data "FAILURE" reason
         Say "** Archie error:" reason
      End
 
      Otherwise
         Say "Unknown record type:"
         Say data
         Say ""
   End
End
If complete Then Do
   Say "Host" host
   Say "    Location:" dir
   Say "     " type modes Right(size,10) fdate name
End
 
Exit:
/*
**   All done, relinquish our socket descriptor
*/
Parse Value Socket('Close', socket) With rc .
If rc^=0 Then Call Error "CLOSE"
 
 
/*
**   And tell RXSOCKET that we are done with this socket set
*/
Parse Value Socket('Terminate', 'ArchieC') With rc .
If rc^=0 Then Call Error "TERMINATE"
 
Exit
 
 
/*
**   Error routine
*/
Error:
   Arg subfunction
 
   Say "TCP/IP error detected on line" sigl-1":"
   Say ""
   Say '   "'Strip(SourceLine(sigl-1))'"'
   Say ""
   Say TcpError(subfunction)
 
   Parse Value Socket('Close', socket) With rc .
   If rc^=0 Then Say TcpError("CLOSE")
 
   Parse Value Socket('Terminate') With rc .
   If rc^=0 Then Say TcpError("TERMINATE")
 
   Exit