home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 35 Internet / 35-Internet.zip / os2pops.zip / WebReg.CMDSample < prev   
Text File  |  1997-05-08  |  25KB  |  461 lines
  1. /**********************************************************************/
  2. /*                                                                    */
  3. /* (c) Copyright IBM Corporation 1997 - All rights reserved.          */
  4. /*                                                                    */
  5. /* This is a sample program that allows new clients to be defined to  */
  6. /* a OS2PopS POP server via the Web.  It is used within IBM on a      */
  7. /* Web server running GoServe.                                        */
  8. /*                                                                    */
  9. /* As shipped this example will attempt to use the GoServe Web server */
  10. /* on the machine it is running on on port 81 instead of the normal   */
  11. /* HTTP port 80.  It also assumes that the OS2PopS POP server is on   */
  12. /* the same machine and has been configured for remote administration */
  13. /* with at least 1 remote administrator defined.                      */
  14. /*                                                                    */
  15. /**********************************************************************/
  16. /*                                                                    */
  17. /* Change History:                                                    */
  18. /*                                                                    */
  19. /* Change Date Int Description of change                              */
  20. /* ----------- --- -------------------------------------------------- */
  21. /* 08 May 1997 DJM First release as an example for the OS2POPS server */
  22. /*                                                                    */
  23. /**********************************************************************/
  24. BaseURL      = "http://127.0.0.1:81/response.html"
  25. LogFile      = "E:\GoServe\WebReg.LogFile"
  26. server.!addr = '127.0.0.1'
  27. AdminID      = "webserver"
  28. AdminPW      = "webremotePW"
  29. images       = "/images/"
  30. /**********************************************************************/
  31. trace "OFF"
  32. parse source . . ourname .                            /* get our name */
  33. ourname = translate(substr(ourname,lastpos('\',ourname)),'/','\')
  34. parse arg source , request , sel , tempfile        /* get passed info */
  35. sel = translate(sel)                 /* upper case it to work with it */
  36. parse var sel . '/' function
  37. if CheckFunctions()
  38.   then signal Exit_WebReg
  39. sockdom        = 'AF_INET'                                /* constant */
  40. server.!family = 'AF_INET'                                /* constant */
  41. server.!port   = 6110           /* the port we'll use to connect with */
  42. hex01          = "01"x
  43. crlf           = "0D0A"x
  44. ok             = "+OK"
  45. err            = "-ERR"
  46. eod            = "0D0A2E0D0A"x
  47. RawData        = 0
  48. /**********************************************************************/
  49. /* Now get to work.                                                   */
  50. /**********************************************************************/
  51. if function == "INITIAL"
  52.   then do
  53.          call Initial_Page
  54.          signal Exit_WebReg
  55.        end
  56. 'read body var indata'                       /* get the incoming data */
  57. indata = translate(indata,' ','+')
  58. parse var indata 'userid=' uid '&' . ; uid   = strip(packur(uid))
  59. parse var indata 'passw1=' pw1 '&' . ; pw1   = strip(packur(pw1))
  60. parse var indata 'passw2=' pw2 '&' . ; pw2   = strip(packur(pw2))
  61. select                       /* check the data that the user supplied */
  62.   when uid == ''
  63.       then do
  64.              call Data_Missing
  65.              signal Exit_WebReg              /* that's all here folks */
  66.            end
  67.   when translate(pw1) \= translate(pw2)      /* passwords don't match */
  68.       then do
  69.              call PassWord_MisMatch
  70.              signal Exit_WebReg              /* that's all here folks */
  71.            end
  72.   when translate(pw1) == translate(uid)               /* pw = user id */
  73.       then do
  74.              call PassWord_UserID
  75.              signal Exit_WebReg              /* that's all here folks */
  76.            end
  77.   when length(pw1) < 6                       /* password is too short */
  78.       then do
  79.              call PassWord_ToShort
  80.              signal Exit_WebReg              /* that's all here folks */
  81.            end
  82.   when pos(' ',pw1) > 0                   /* password contains blanks */
  83.       then do
  84.              call PassWord_Blanks
  85.              signal Exit_WebReg              /* that's all here folks */
  86.            end
  87.   when pos('@',uid) > 0          /* can't have a @ in the POP user ID */
  88.       then do
  89.              call Invalid_POPID
  90.              signal Exit_WebReg              /* that's all here folks */
  91.            end
  92.   otherwise nop                    /* otherwise the raw data looks OK */
  93. end                       /* of select based on what the user entered */
  94. /**********************************************************************/
  95. /* If we get here we've got enough data to connect to the POP server  */
  96. /* and find out if the requested POP User ID is available.            */
  97. /**********************************************************************/
  98. if Server_LogIn()
  99.   then signal Exit_WebReg
  100. if Check_UserID()
  101.   then signal Exit_WebReg
  102. if ClientID \= ""                    /* ID requested is already taken */
  103.   then do
  104.          call UserID_Taken
  105.          signal Exit_WebReg
  106.        end
  107. if Server_LogIn()
  108.   then signal Exit_WebReg
  109. if Add_Client()
  110.   then signal Exit_WebReg
  111. call LogIt
  112. call UserID_Added
  113. Exit_WebReg:                   /* label for branch when we're leaving */
  114. return 'FILE ERASE TYPE text/html NAME' tempfile
  115. exit                      /* just in case though we'll never get here */
  116. /**********************************************************************/
  117. /* The mainline program ends here and the subroutines needed are next */
  118. /**********************************************************************/
  119. Server_LogIn:                            /* connect to the POP server */
  120.   sendback = 0      /* assume there will be a problem just to be safe */
  121.   sockit = SockSocket(sockdom,'Sock_Stream',0)        /* get a socket */
  122.   rc = SockConnect(sockit,'server.!')        /* connect to the server */
  123.   if rc \= 0            /* couldn't connect to server for some reason */
  124.     then do
  125.            call Unexpected_Error 'Socket connect failed with a return' ,
  126.                              'code of' rc'.'
  127.            signal Exit_Server_LogIn
  128.          end                                         /* of if rc \= 0 */
  129.   databack = receive_data()                   /* get initial greeting */
  130.   if Check_For_OK()                         /* first word must be +OK */
  131.     then do
  132.            call Unexpected_Error "POP server isn't ready to accept" ,
  133.                                  "connections"
  134.            signal Exit_Server_LogIn
  135.          end                                   /* of if \Check_For_OK */
  136.   parse var databack . "<" ServerDigest ">"
  137.   ServerDigest = "<" || ServerDigest || ">"
  138.   if Send_Data("RADMIN" AdminID MD5Compute(ServerDigest || AdminPW))
  139.     then signal Exit_Server_LogIn
  140.   databack = receive_data()               /* wait for server response */
  141.   if databack == ""
  142.     then signal Exit_Server_LogIn
  143.   if Check_For_OK()                         /* first word must be +OK */
  144.     then do
  145.            call Unexpected_Error "Invalid admin User ID/Password"
  146.            signal Exit_Server_LogIn
  147.          end
  148.   Exit_Server_LogIn:
  149. return sendback                 /* end of the Server_LogIn subroutine */
  150. /**********************************************************************/
  151. Check_UserID:               /* ask server about the requested User ID */
  152.   ClientID   = ""
  153.   ClientName = ""
  154.   sendback   = 0    /* assume there will be a problem just to be safe */
  155.   do lp = 1 to length(uid)       /* go through each letter of user ID */
  156.     char = substr(uid,lp,1)                    /* extract a character */
  157.     if datatype(char,"U")                       /* upper case letter? */
  158.       then uid = overlay(bitor(char,"20"x),uid,lp)        /* lower it */
  159.   end                                  /* of do lp = 1 to length(uid) */
  160.   if Send_Data('USERDATA' uid)               /* send over the user ID */
  161.     then signal Exit_Check_UserID
  162.   databack = receive_data()               /* wait for server response */
  163.   if sendback        /* something drastic happened waiting to receive */
  164.     then signal Exit_Check_UserID
  165.   if \Check_For_OK()                         /* we got an OK response */
  166.     then do
  167.            RawData  = 1
  168.            databack = ""
  169.            do forever until pos(eod,databack) \= 0
  170.              databack = databack || receive_data()    /* get response */
  171.            end
  172.            RawData = 0
  173.            databack = substr(databack,1,length(databack) - 3)  /* EOD */
  174.            parse var databack ClientID (hex01) .
  175.          end
  176.   sendback = 0                                    /* reset error flag */
  177.   junk = send_Data("QUIT")          /* disconnect from the server now */
  178.   Exit_Check_UserID:
  179.   if datatype(sockit,"W")             /* we still have a valid socket */
  180.     then call SockClose sockit       /* make sure we close our socket */
  181. return sendback                 /* end of the Check_UserID subroutine */
  182. /**********************************************************************/
  183. Add_Client:
  184.   sendback = 0      /* assume there will be a problem just to be safe */
  185.   ClientData = hex01     || ,
  186.                uid       || ,
  187.                hex01     || ,
  188.                pw1       || ,
  189.                hex01     || ,
  190.                "Client comment info goes here" || ,
  191.                hex01
  192.   if Send_Data("ADDCLIENT" ClientData)
  193.     then signal Exit_Add_Client
  194.   DataBack = Receive_Data()
  195.   if databack == ""
  196.     then signal Exit_Add_Client
  197.   if Check_For_OK()
  198.     then call Unexpected_Error "Error adding client to server"
  199.   junk = Send_Data("QUIT")          /* disconnect from the server now */
  200.   call SockClose sockit              /* make sure we close our socket */
  201.   tuid = translate(uid)           /* upper case requested POP user ID */
  202.   Exit_Add_Client:
  203. return sendback                   /* end of the Add_Client subroutine */
  204. /**********************************************************************/
  205. Send_Data: procedure expose sockit crlf tempfile
  206.   parse arg datatosend              /* get data to send to the server */
  207.   datatosend = datatosend || crlf                     /* add the crlf */
  208.   sendback = 0      /* assume there will be a problem just to be safe */
  209.   Send_Data_Again:
  210.     datalong = length(datatosend)        /* how much do we have here? */
  211.     if wait_for_write() == 0      /* timed out waiting for the server */
  212.       then do
  213.              call Unexpected_Error 'Timeout waiting for server' ,
  214.                                    'receive enable on socket' sockit
  215.              signal Exit_Send_Data
  216.            end
  217.     SendRC = SockSend(sockit,datatosend)   /* send along the data */
  218.     if SendRC == -1
  219.       then do
  220.              call Unexpected_Error 'Fatal error writing to server' ,
  221.                                    'socket' sockit', connection' ,
  222.                                    'closed.' errno
  223.              signal Exit_Send_Data
  224.            end
  225.     if SendRC \= datalong          /* not all of the data made it out */
  226.       then do
  227.              datatosend = substr(datatosend,SendRC + 1)   /* get rest */
  228.              signal Send_Data_Again       /* and try to send it along */
  229.            end                            /* of if SendRC \= datalong */
  230.   Exit_Send_Data:
  231. return sendback                    /* end of the Send_Data subroutine */
  232. /**********************************************************************/
  233. Receive_Data: procedure expose sockit crlf RawData tempfile
  234.   sdata    = ""                       /* clear received data variable */
  235.   sendback = 0      /* assume there will be a problem just to be safe */
  236.   Wait_For_Data:
  237.     if wait_for_receive() == 0   /* timed out waiting for the server */
  238.       then do
  239.              call Unexpected_Error 'Timeout waiting for server to' ,
  240.                                    'send data on socket' sockit
  241.              signal Exit_Receive_Data
  242.            end
  243.     rc = SockRecv(sockit,'datain',4096)
  244.     if rc == 0
  245.       then do
  246.              call Unexpected_Error 'Server using socket' sockit ,
  247.                                    'disconnected during conversation'
  248.              signal Exit_Receive_Data
  249.            end
  250.     if rc == -1
  251.       then do
  252.              call Unexpected_Error 'Fatal error on server socket' ,
  253.                                     sockit', connection closed.' errno
  254.              signal Exit_Receive_Data
  255.            end
  256.     sdata = sdata || datain
  257.     if pos(crlf,sdata) == 0
  258.       then signal wait_for_data
  259.     if RawData                    /* caller wants exactly what we get */
  260.       then signal Exit_Receive_Data      /* so give it back right now */
  261.     parse var sdata sdata (crlf)
  262.   Exit_Receive_Data:
  263. return sdata                    /* end of the Receive_Data subroutine */
  264. /**********************************************************************/
  265. Check_For_OK:             /* see if the first word of response is +OK */
  266.   if substr(DataBack,1,3) \= ok
  267.     then SendBack = 1
  268.     else SendBack = 0
  269. return SendBack                 /* end of the Check_For_OK subroutine */
  270. /**********************************************************************/
  271. WriteIt: procedure expose tempfile       /* write a line to temp file */
  272.   parse arg line2write
  273.   call lineout tempfile,line2write
  274. return                               /* end of the WriteIt subroutine */
  275. /**********************************************************************/
  276. Unexpected_Error:         /* common routine when server errors happen */
  277.   parse arg ErrMsg
  278.   call Response_Head "Unexpected Registration Error"   /* resp header */
  279.  
  280.   call writeit "An unexpected error occurred trying to communicate" ,
  281.                "with the POP server to add your POP User ID.<p>"    ,
  282.                "Please try again in a few minutes.  If you receive" ,
  283.                "another message like this please let us know.<p>"   ,
  284.                "The error message was:" ErrMsg "<hr>"
  285.   call Response_Tail                 /* write common response trailer */
  286.   sendback = 1                            /* turn on the failure flag */
  287. return                      /* end of the Unexpected_Error subroutine */
  288. /**********************************************************************/
  289. Data_Missing:                 /* required data not entered; try again */
  290.   call Response_Head "Missing Information"   /* write response header */
  291.   call writeit "You didn't complete all of the fields on the"  ,
  292.                "registration form.<p>Only forms with all of the" ,
  293.                "fields completed may be processed.<p> Please"   ,
  294.                "try again.<hr>"
  295.   call Response_Tail                 /* write common response trailer */
  296. return                          /* end of the Data_Missing subroutine */
  297. /**********************************************************************/
  298. PassWord_MisMatch:               /* the passwords entered don't match */
  299.   call Response_Head "Passwords Did Not Match"     /* response header */
  300.   call writeit "The passwords you entered did not match.<p>Please try" ,
  301.                "again.<hr>"
  302.   call Response_Tail                 /* write common response trailer */
  303. return                     /* end of the PassWord_MisMatch subroutine */
  304. /**********************************************************************/
  305. PassWord_UserID:                    /* the password and user ID match */
  306.   call Response_Head "Password Equals User ID"   /* write resp header */
  307.   call writeit "The password you entered matches the user ID you"   ,
  308.                "selected.<p>For security reasons your password may" ,
  309.                "not be the same as your POP user ID.<p>Please try"  ,
  310.                "again.<hr>"
  311.   call Response_Tail                 /* write common response trailer */
  312. return                       /* end of the PassWord_UserID subroutine */
  313. /**********************************************************************/
  314. PassWord_ToShort:                 /* password must be at least 6 long */
  315.   call Response_Head "Password Is To Short"      /* write resp header */
  316.   call writeit "The password you entered is less than 6 characters" ,
  317.                "long.<p>For security reasons your password must" ,
  318.                "be at least 6 characters long.<p>Please try"  ,
  319.                "again.<hr>"
  320.   call Response_Tail                 /* write common response trailer */
  321. return                      /* end of the PassWord_ToShort subroutine */
  322. /**********************************************************************/
  323. PassWord_Blanks:                          /* password contains blanks */
  324.   call Response_Head "Password Contains Blanks"  /* write resp header */
  325.   call writeit "The password you entered contains 1 or more blanks." ,
  326.                "<p>Passwords may be up to 50 characters long but may" ,
  327.                "not contain blanks.<p>Please try again.<hr>"
  328.   call Response_Tail                 /* write common response trailer */
  329. return                       /* end of the PassWord_Blanks subroutine */
  330. /**********************************************************************/
  331. Invalid_POPID:                                 /* POP ID contains a @ */
  332.   call Response_Head "POP User ID Contains @"    /* write resp header */
  333.   call writeit "The POP user ID you entered contains a @ which is" ,
  334.                "not valid as part of the POP user ID.<p>Please" ,
  335.                "choose another POP user ID.<hr>"
  336.   call Response_Tail                 /* write common response trailer */
  337. return                         /* end of the Invalid_POPID subroutine */
  338. /**********************************************************************/
  339. UserID_Taken:                           /* requested ID already taken */
  340.   call Response_Head "User ID Already Taken"     /* write resp header */
  341.   call writeit "Sorry but somebody else is already using the" uid ,
  342.                "User ID.<p>Please choose another User ID.<hr>"
  343.   call Response_Tail                 /* write common response trailer */
  344. return                          /* end of the UserID_Taken subroutine */
  345. /**********************************************************************/
  346. UserID_Added:                      /* user ID was added to the server */
  347.   call Response_Head "User ID Added Successfully"/* write resp header */
  348.   call writeit "<center>User ID" uid "has been added to the POP server"
  349.   call writeit "<p>Thank you for using our POP server.<p></center>"
  350.                '</body></html>'
  351.   call stream tempfile,'c','close'             /* close temp file now */
  352. return                          /* end of the UserID_Added subroutine */
  353. /**********************************************************************/
  354. Response_Head:                       /* write common response heading */
  355.   parse arg heading                     /* get header line to be used */
  356.   call writeit "<html><head><title>Sample POP Registration -" || ,
  357.                 heading || "</title></head>"
  358.   call writeit '<base href="' || BaseURL || '"></head>'
  359.   call writeit '<body><em><hr>' || heading || '</h1><hr>'
  360. return                         /* end of the Response_Head subroutine */
  361. /**********************************************************************/
  362. Response_Tail:                       /* write common response trailer */
  363.   call writeit '<a href="/popsreg.cmd/initial">Return to the POP' ,
  364.                'Registration Page</a></center></body></html>'
  365.   call stream tempfile,'c','close'             /* close temp file now */
  366. return                         /* end of the Response_Tail subroutine */
  367. /**********************************************************************/
  368. Wait_For_Receive: procedure expose sockit
  369.   parse arg delay
  370.   if delay == "" | \datatype(delay,'W')
  371.     then delay = 45                          /* 45 seconds by default */
  372.   r.0 = 1
  373.   r.1 = sockit
  374. return SockSelect('r.',,,delay)
  375. /**********************************************************************/
  376. Wait_For_Write: procedure expose sockit
  377.   parse arg delay
  378.   if delay == "" | \datatype(delay,'W')
  379.     then delay = 45                          /* 45 seconds by default */
  380.   w.0 = 1
  381.   w.1 = sockit
  382. return SockSelect(,'w.',,delay)
  383. /**********************************************************************/
  384. Initial_Page:                          /* show main registration page */
  385.   call writeit "<html><head><title>Sample POP Server Registration" || ,
  386.                "</title></head>"
  387.   call writeit '<base href="' || BaseURL || '"></head>'
  388.   call writeit '<body><center><h1>POP Server' ,
  389.                'Registration Form</h1></center><hr>'
  390.   call writeit "<center><h2>Important Notes</h2></center><ul>"
  391.   call writeit "<li>The user ID should always be lower case.  ABC" ,
  392.                "== abc<li>The POP server password is <em>CaSe" ,
  393.                "SeNsItIvE</em>.<li><em>All</em> fields must be" ,
  394.                "completed or your request can not be processed." ,
  395.                "<li>Passwords may be any combination" ,
  396.                "of upper and lower case characters but may" ,
  397.                "<em>not</em> contain blanks.  To maintain" ,
  398.                "the security of your mail, choose something" ,
  399.                "that includes numbers and characters or use a" ,
  400.                "phrase.  You may have a password that is up to" ,
  401.                "50 characters long.<p></ul>"
  402.   call writeit '<form ACTION="/WebReg.cmd/" METHOD=POST><center>'
  403.   call writeit "<table width=750 cellspacing=10 cellpadding=0" ,
  404.                "border=0>"
  405.   call writeit "<tr><th colspan=2>POP server User ID" ,
  406.                "<br>(may be up to 20 characters long)</th></tr>"
  407.   call writeit '<tr><td colspan=2 align=center><input name="userid"' ,
  408.                'size="20" maxlength="20"></td></tr>'
  409.   call writeit "<tr><th colspan=2 align=center>Passwords may be up" ,
  410.                "to 50 characters long</th></tr>"
  411.   call writeit "<tr><th>POP server password desired</th>"
  412.   call writeit "<th>POP password again for verification</th></tr>"
  413.   call writeit '<tr><td align=center><input name="passw1" size="20"' ,
  414.                'type="password" maxlength="50"></td>'
  415.   call writeit '<td align=center><input name="passw2" size="20"' ,
  416.                'type="password" maxlength="50"></td></tr>'
  417.   call writeit "<tr><th colspan=2><font size=+2>Please Note" ,
  418.                "</font></th></tr>"
  419.   call writeit '<tr><td colspan=2 align=center><font size=+2' ,
  420.                'color="Fuchsia">Processing of your request may' ,
  421.                'take up to 2 minutes.  Please be patient</font>' ,
  422.                '</td></tr>'
  423.   call writeit '</table><p><input type="submit" value="Process' ,
  424.                'Request">'
  425.   call writeit '<p><input type="reset"  value="Clear Form"><p>'
  426.   call writeit '<a href="os2pop.htm">Return to the POP Page</a>'
  427.   call writeit "</center></FORM></body></html>"
  428. return                          /* end of the Initial_Page subroutine */
  429. /**********************************************************************/
  430. CheckFunctions:
  431.   sendback = 0
  432.   signal on syntax name Function_Load_Failed
  433.   needed = 'SysFileSearch SysFileTree'
  434.   do lp = 1 to words(needed)    /* go through each function name we need */
  435.     func = word(needed,lp)                    /* extract a function name */
  436.     rc = RxFuncAdd(func,'RexxUtil',func)             /* brute force load */
  437.   end                                   /* of do lp = 1 to words(needed) */
  438.   rc = RxFuncAdd('SockLoadFuncs','rxsock','SockLoadFuncs')
  439.   rc = SockLoadFuncs("QUIET")
  440.   rc = RxFuncAdd("MD5LoadFuncs","rxmd5","MD5LoadFuncs")
  441.   rc = MD5LoadFuncs("QUIET")
  442.   signal off syntax
  443. return sendback               /* end of the CheckFunctions subroutine */
  444. /**********************************************************************/
  445. Function_Load_Failed:
  446.   call Response_Head "Fatal Error On Web Server"      /* write header */
  447.   call writeit "One or more Rexx or Socket functions did not load" ,
  448.                "correctly on the Web server.<p>Please contact the" ,
  449.                "Web server owner and let them know there is a" ,
  450.                "problem.<p>Your request for a POP client can not" ,
  451.                "be processed right now.<p>"
  452.   call Response_Tail                 /* write common response trailer */
  453.   sendback = 1
  454. return sendback         /* end of the Function_Load_Failed subroutine */
  455. /**********************************************************************/
  456. LogIt:                          /* record transaction in our log file */
  457.   call lineout LogFile,date("S") time("N") uid
  458.   call stream LogFile,"C","Close"
  459. return                                 /* end of the LogIt subroutine */
  460. /**********************************************************************/
  461.