/**********************************************************************/
/* */
/* (c) Copyright IBM Corporation 1997 - All rights reserved. */
/* */
/* This is a sample program that allows new clients to be defined to */
/* a OS2PopS POP server via the Web. It is used within IBM on a */
/* Web server running GoServe. */
/* */
/* As shipped this example will attempt to use the GoServe Web server */
/* on the machine it is running on on port 81 instead of the normal */
/* HTTP port 80. It also assumes that the OS2PopS POP server is on */
/* the same machine and has been configured for remote administration */
/* with at least 1 remote administrator defined. */
/* */
/**********************************************************************/
/* */
/* Change History: */
/* */
/* Change Date Int Description of change */
/* ----------- --- -------------------------------------------------- */
/* 08 May 1997 DJM First release as an example for the OS2POPS server */
/* */
/**********************************************************************/
BaseURL = "http://127.0.0.1:81/response.html"
LogFile = "E:\GoServe\WebReg.LogFile"
server.!addr = '127.0.0.1'
AdminID = "webserver"
AdminPW = "webremotePW"
images = "/images/"
/**********************************************************************/
trace "OFF"
parse source . . ourname . /* get our name */
ourname = translate(substr(ourname,lastpos('\',ourname)),'/','\')
parse arg source , request , sel , tempfile /* get passed info */
sel = translate(sel) /* upper case it to work with it */
parse var sel . '/' function
if CheckFunctions()
then signal Exit_WebReg
sockdom = 'AF_INET' /* constant */
server.!family = 'AF_INET' /* constant */
server.!port = 6110 /* the port we'll use to connect with */
hex01 = "01"x
crlf = "0D0A"x
ok = "+OK"
err = "-ERR"
eod = "0D0A2E0D0A"x
RawData = 0
/**********************************************************************/
/* Now get to work. */
/**********************************************************************/
if function == "INITIAL"
then do
call Initial_Page
signal Exit_WebReg
end
'read body var indata' /* get the incoming data */
indata = translate(indata,' ','+')
parse var indata 'userid=' uid '&' . ; uid = strip(packur(uid))
parse var indata 'passw1=' pw1 '&' . ; pw1 = strip(packur(pw1))
parse var indata 'passw2=' pw2 '&' . ; pw2 = strip(packur(pw2))
select /* check the data that the user supplied */
when uid == ''
then do
call Data_Missing
signal Exit_WebReg /* that's all here folks */
end
when translate(pw1) \= translate(pw2) /* passwords don't match */
then do
call PassWord_MisMatch
signal Exit_WebReg /* that's all here folks */
end
when translate(pw1) == translate(uid) /* pw = user id */
then do
call PassWord_UserID
signal Exit_WebReg /* that's all here folks */
end
when length(pw1) < 6 /* password is too short */
then do
call PassWord_ToShort
signal Exit_WebReg /* that's all here folks */
end
when pos(' ',pw1) > 0 /* password contains blanks */
then do
call PassWord_Blanks
signal Exit_WebReg /* that's all here folks */
end
when pos('@',uid) > 0 /* can't have a @ in the POP user ID */
then do
call Invalid_POPID
signal Exit_WebReg /* that's all here folks */
end
otherwise nop /* otherwise the raw data looks OK */
end /* of select based on what the user entered */
/**********************************************************************/
/* If we get here we've got enough data to connect to the POP server */
/* and find out if the requested POP User ID is available. */
/**********************************************************************/
if Server_LogIn()
then signal Exit_WebReg
if Check_UserID()
then signal Exit_WebReg
if ClientID \= "" /* ID requested is already taken */
then do
call UserID_Taken
signal Exit_WebReg
end
if Server_LogIn()
then signal Exit_WebReg
if Add_Client()
then signal Exit_WebReg
call LogIt
call UserID_Added
Exit_WebReg: /* label for branch when we're leaving */
return 'FILE ERASE TYPE text/html NAME' tempfile
exit /* just in case though we'll never get here */
/**********************************************************************/
/* The mainline program ends here and the subroutines needed are next */
/**********************************************************************/
Server_LogIn: /* connect to the POP server */
sendback = 0 /* assume there will be a problem just to be safe */
sockit = SockSocket(sockdom,'Sock_Stream',0) /* get a socket */
rc = SockConnect(sockit,'server.!') /* connect to the server */
if rc \= 0 /* couldn't connect to server for some reason */
then do
call Unexpected_Error 'Socket connect failed with a return' ,
'code of' rc'.'
signal Exit_Server_LogIn
end /* of if rc \= 0 */
databack = receive_data() /* get initial greeting */
if Check_For_OK() /* first word must be +OK */
then do
call Unexpected_Error "POP server isn't ready to accept" ,
"connections"
signal Exit_Server_LogIn
end /* of if \Check_For_OK */
parse var databack . "<" ServerDigest ">"
ServerDigest = "<" || ServerDigest || ">"
if Send_Data("RADMIN" AdminID MD5Compute(ServerDigest || AdminPW))
then signal Exit_Server_LogIn
databack = receive_data() /* wait for server response */
if databack == ""
then signal Exit_Server_LogIn
if Check_For_OK() /* first word must be +OK */
then do
call Unexpected_Error "Invalid admin User ID/Password"
signal Exit_Server_LogIn
end
Exit_Server_LogIn:
return sendback /* end of the Server_LogIn subroutine */
/**********************************************************************/
Check_UserID: /* ask server about the requested User ID */
ClientID = ""
ClientName = ""
sendback = 0 /* assume there will be a problem just to be safe */
do lp = 1 to length(uid) /* go through each letter of user ID */
char = substr(uid,lp,1) /* extract a character */
if datatype(char,"U") /* upper case letter? */
then uid = overlay(bitor(char,"20"x),uid,lp) /* lower it */
end /* of do lp = 1 to length(uid) */
if Send_Data('USERDATA' uid) /* send over the user ID */
then signal Exit_Check_UserID
databack = receive_data() /* wait for server response */
if sendback /* something drastic happened waiting to receive */
then signal Exit_Check_UserID
if \Check_For_OK() /* we got an OK response */
then do
RawData = 1
databack = ""
do forever until pos(eod,databack) \= 0
databack = databack || receive_data() /* get response */
end
RawData = 0
databack = substr(databack,1,length(databack) - 3) /* EOD */
parse var databack ClientID (hex01) .
end
sendback = 0 /* reset error flag */
junk = send_Data("QUIT") /* disconnect from the server now */
Exit_Check_UserID:
if datatype(sockit,"W") /* we still have a valid socket */
then call SockClose sockit /* make sure we close our socket */
return sendback /* end of the Check_UserID subroutine */
/**********************************************************************/
Add_Client:
sendback = 0 /* assume there will be a problem just to be safe */
ClientData = hex01 || ,
uid || ,
hex01 || ,
pw1 || ,
hex01 || ,
"Client comment info goes here" || ,
hex01
if Send_Data("ADDCLIENT" ClientData)
then signal Exit_Add_Client
DataBack = Receive_Data()
if databack == ""
then signal Exit_Add_Client
if Check_For_OK()
then call Unexpected_Error "Error adding client to server"
junk = Send_Data("QUIT") /* disconnect from the server now */
call SockClose sockit /* make sure we close our socket */
tuid = translate(uid) /* upper case requested POP user ID */
Exit_Add_Client:
return sendback /* end of the Add_Client subroutine */
/**********************************************************************/
Send_Data: procedure expose sockit crlf tempfile
parse arg datatosend /* get data to send to the server */
datatosend = datatosend || crlf /* add the crlf */
sendback = 0 /* assume there will be a problem just to be safe */
Send_Data_Again:
datalong = length(datatosend) /* how much do we have here? */
if wait_for_write() == 0 /* timed out waiting for the server */
then do
call Unexpected_Error 'Timeout waiting for server' ,
'receive enable on socket' sockit
signal Exit_Send_Data
end
SendRC = SockSend(sockit,datatosend) /* send along the data */
if SendRC == -1
then do
call Unexpected_Error 'Fatal error writing to server' ,
'socket' sockit', connection' ,
'closed.' errno
signal Exit_Send_Data
end
if SendRC \= datalong /* not all of the data made it out */
then do
datatosend = substr(datatosend,SendRC + 1) /* get rest */
signal Send_Data_Again /* and try to send it along */
end /* of if SendRC \= datalong */
Exit_Send_Data:
return sendback /* end of the Send_Data subroutine */
/**********************************************************************/
Receive_Data: procedure expose sockit crlf RawData tempfile
sdata = "" /* clear received data variable */
sendback = 0 /* assume there will be a problem just to be safe */
Wait_For_Data:
if wait_for_receive() == 0 /* timed out waiting for the server */
then do
call Unexpected_Error 'Timeout waiting for server to' ,
'send data on socket' sockit
signal Exit_Receive_Data
end
rc = SockRecv(sockit,'datain',4096)
if rc == 0
then do
call Unexpected_Error 'Server using socket' sockit ,
'disconnected during conversation'
signal Exit_Receive_Data
end
if rc == -1
then do
call Unexpected_Error 'Fatal error on server socket' ,
sockit', connection closed.' errno
signal Exit_Receive_Data
end
sdata = sdata || datain
if pos(crlf,sdata) == 0
then signal wait_for_data
if RawData /* caller wants exactly what we get */
then signal Exit_Receive_Data /* so give it back right now */
parse var sdata sdata (crlf)
Exit_Receive_Data:
return sdata /* end of the Receive_Data subroutine */
/**********************************************************************/
Check_For_OK: /* see if the first word of response is +OK */
if substr(DataBack,1,3) \= ok
then SendBack = 1
else SendBack = 0
return SendBack /* end of the Check_For_OK subroutine */
/**********************************************************************/
WriteIt: procedure expose tempfile /* write a line to temp file */
parse arg line2write
call lineout tempfile,line2write
return /* end of the WriteIt subroutine */
/**********************************************************************/
Unexpected_Error: /* common routine when server errors happen */
parse arg ErrMsg
call Response_Head "Unexpected Registration Error" /* resp header */
call writeit "An unexpected error occurred trying to communicate" ,
"with the POP server to add your POP User ID." ,
"Please try again in a few minutes. If you receive" ,
"another message like this please let us know.
" ,
"The error message was:" ErrMsg "
"
call Response_Tail /* write common response trailer */
sendback = 1 /* turn on the failure flag */
return /* end of the Unexpected_Error subroutine */
/**********************************************************************/
Data_Missing: /* required data not entered; try again */
call Response_Head "Missing Information" /* write response header */
call writeit "You didn't complete all of the fields on the" ,
"registration form.Only forms with all of the" ,
"fields completed may be processed.
Please" ,
"try again.
"
call Response_Tail /* write common response trailer */
return /* end of the Data_Missing subroutine */
/**********************************************************************/
PassWord_MisMatch: /* the passwords entered don't match */
call Response_Head "Passwords Did Not Match" /* response header */
call writeit "The passwords you entered did not match.Please try" ,
"again.
"
call Response_Tail /* write common response trailer */
return /* end of the PassWord_MisMatch subroutine */
/**********************************************************************/
PassWord_UserID: /* the password and user ID match */
call Response_Head "Password Equals User ID" /* write resp header */
call writeit "The password you entered matches the user ID you" ,
"selected.For security reasons your password may" ,
"not be the same as your POP user ID.
Please try" ,
"again.
"
call Response_Tail /* write common response trailer */
return /* end of the PassWord_UserID subroutine */
/**********************************************************************/
PassWord_ToShort: /* password must be at least 6 long */
call Response_Head "Password Is To Short" /* write resp header */
call writeit "The password you entered is less than 6 characters" ,
"long.For security reasons your password must" ,
"be at least 6 characters long.
Please try" ,
"again.
"
call Response_Tail /* write common response trailer */
return /* end of the PassWord_ToShort subroutine */
/**********************************************************************/
PassWord_Blanks: /* password contains blanks */
call Response_Head "Password Contains Blanks" /* write resp header */
call writeit "The password you entered contains 1 or more blanks." ,
"Passwords may be up to 50 characters long but may" ,
"not contain blanks.
Please try again.
"
call Response_Tail /* write common response trailer */
return /* end of the PassWord_Blanks subroutine */
/**********************************************************************/
Invalid_POPID: /* POP ID contains a @ */
call Response_Head "POP User ID Contains @" /* write resp header */
call writeit "The POP user ID you entered contains a @ which is" ,
"not valid as part of the POP user ID.Please" ,
"choose another POP user ID.
"
call Response_Tail /* write common response trailer */
return /* end of the Invalid_POPID subroutine */
/**********************************************************************/
UserID_Taken: /* requested ID already taken */
call Response_Head "User ID Already Taken" /* write resp header */
call writeit "Sorry but somebody else is already using the" uid ,
"User ID.Please choose another User ID.
"
call Response_Tail /* write common response trailer */
return /* end of the UserID_Taken subroutine */
/**********************************************************************/
UserID_Added: /* user ID was added to the server */
call Response_Head "User ID Added Successfully"/* write resp header */
call writeit "User ID" uid "has been added to the POP server"
call writeit "Thank you for using our POP server.
"
'