home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 35 Internet / 35-Internet.zip / radi116c.zip / radius116c / useredit / raduser.cmd < prev   
OS/2 REXX Batch file  |  1999-01-03  |  27KB  |  1,037 lines
  1. /* RADUser.cmd: RADIUS 'users' file maintenance
  2.   This is a bare bones example thrown together from several
  3.   sources to demonstrate use of PROTREN.EXE and USERS file editing.
  4.   Be sure to test functions you will be using before calling this
  5.   page from a CGI script!
  6.  
  7.   USAGE:  raduser    with no arguments starts in interactive mode
  8.  
  9.    RADUSER loginId,loginpw,sessionLimit,sessionTimeout,fixedIP COMMAND
  10.  
  11. NOTE: sessionTimeout is SECONDS on the commandline
  12.  
  13.      executes 'command' on the passed user information.
  14.      Examples:
  15.         RADUSER bclinton,,,, /delete
  16.            would delete user named 'bclinton' from USERS file
  17.         RADUSER mjackson,crxggy,2,,, /add
  18.            Create user record for mjackson with session limit of 2
  19.         RADUSER jleno,xyzzy,1,18000,10.10.3.21 /Update
  20.            Overwrite any existing record for 'jleno' with
  21.               password=xyzzy
  22.               sessionTimeout of 5 hours
  23.               fixed IP of 10.10.3.21
  24.         RADUSER jleno,xyzzy,1,18000,10.10.3.21 /edit
  25.               Drop into interactive user edit mode.
  26.  
  27.  
  28. */
  29.  
  30.  
  31. /* Initialize global variables */
  32. TRUE=1
  33. FALSE=0
  34. tab="09"x
  35.  
  36. /* Load REXXUTIL */
  37. CALL rxfuncadd sysloadfuncs, rexxutil, sysloadfuncs
  38. CALL sysloadfuncs
  39.  
  40. etcDir=Value('ETC',,'OS2ENVIRONMENT')
  41. if LENGTH(etcDir) > 3 then do
  42.    etcDir = STRIP(etcDir, "T", "\") || "\"
  43. end
  44.  
  45. radDbDir=etcDir || "raddb\"
  46. radUserFile = "Users"
  47. radUserPath = radDbDir || radUserFile
  48.  
  49.  
  50.  
  51. /* --------------------- BEGIN -------------------------------------- */
  52. Say "RADIUS user management"
  53. Say ""
  54.  
  55.  
  56. call DeclareDatabase
  57. call LoadUserDatabase
  58.  
  59.  
  60. PARSE ARG loginId','user.DBLoginPW','user.DBSessionLimit','user.DBSessionTimeout','user.DBFixedIP "/" thisCommand
  61. user.DBLoginID=loginId
  62.  
  63.   thisCommand=STRIP(TRANSLATE(thisCommand))
  64.  
  65.   do stripField=1 TO numDBFields
  66.     user.stripField=STRIP(user.StripField,"B")
  67.     DO WHILE POS('~', user.stripField) > 0
  68.        user.stripField = DELSTR(user.stripField, POS('~', user.stripField), 1)
  69.     END
  70.   end
  71.  
  72.   commandlineRecord=MakeDBRecord()
  73.  
  74.  
  75.   interactive=FALSE
  76.   commandOk=TRUE
  77.   select
  78.     when thisCommand="" then do
  79.        title="Interactive maintenance"
  80.        interactive=TRUE
  81.     end
  82.     when thisCommand="CREATE" then do
  83.        title="Create user"
  84.        CALL ShowSettings
  85.        call UpdateRadiusDB("ADD")
  86.     end
  87.     when thisCommand="EDIT" then do
  88.        /* Interactive edit, passed on command line */
  89.        title="Modify user"
  90.        interactive=TRUE
  91.        CALL EditUser(commandlineRecord)
  92.     end
  93.     when thisCommand="DELETE" then do
  94.        title="Delete user"
  95.        call UpdateRadiusDB("DELETE")
  96.     end
  97.     when thisCommand="UPDATE" then do
  98.        title="Change user"
  99.        CALL ShowSettings
  100.        call UpdateRadiusDB("UPDATE")
  101.     end
  102.     otherwise do
  103.        say "??? Unknown Command ??? " || thisCommand
  104.        commandOk=FALSE
  105.        interactive=TRUE
  106.     end
  107.   end
  108.  
  109.   if \interactive THEN DO
  110.     /* Common exit for commandline invoked */
  111.     EXIT 0
  112.   END
  113.   
  114.  
  115. DO UNTIL (haveLoginId)
  116.  
  117.    IF loginId="" THEN DO
  118.       Say
  119.      Call Charout, "Enter user login name : "
  120.      loginId=GetString()
  121.    END
  122.  
  123.    loginId=STRIP(loginId,"B")
  124.    if loginID="" then do
  125.       exit 1
  126.    end
  127.  
  128.    if FindUserRecord(loginId) then do
  129.       Say
  130.       Say  "User "loginId" already exists"
  131.       Say
  132.       say tab"<E>dit user record"
  133.       say tab"<D>elete user from system"
  134.       say tab"change <L>ogin name"
  135.       Call Charout,  tab"oops! <R>e-enter name.... "
  136.       DO UNTIL ( POS(key, "EDLR") > 0)
  137.         parse upper value SysGetKey('NOECHO') with key
  138.         /* Check for ESCAPE */
  139.         IF key='1B'X THEN EXIT 1
  140.       END
  141.       Say key
  142.  
  143.      SELECT
  144.        WHEN key='E'  THEN DO    /* Edit user */
  145.           dBRecord=MakeDBRecord()
  146.           CALL EditUser(dbRecord)
  147.           EXIT 0
  148.        END
  149.        WHEN key='D'  THEN DO    /* Delete user */
  150.           dBRecord=MakeDBRecord()
  151.           rc1=DeleteUser(dbRecord,TRUE)
  152.           EXIT 0
  153.        END
  154.        WHEN key='L'  THEN DO    /* Change login name */
  155.           oldDBRecord=MakeDBRecord()
  156.           CALL RenameUser(oldDBRecord)
  157.           EXIT 0
  158.        END
  159.        WHEN key='R'  THEN DO    /* Re-enter */
  160.          haveLoginId = FALSE
  161.          loginID=""
  162.        END
  163.      END
  164.  
  165.  
  166.    end
  167.    ELSE do
  168.       haveLoginID=GetYesNo("Create user" loginId)
  169.       if \haveLoginID then do
  170.         loginID=""
  171.       end
  172.    end
  173. end
  174.  
  175. /* Create new user */
  176. createDBRecord=DefaultDbRecord(loginId)
  177.  
  178. createDBRecord=CreateUser(createDBRecord)
  179.  
  180.  
  181. EXIT 0
  182.  
  183.  
  184. /* =================================================================== */
  185. RenameUser:
  186.   oldRecord=ARG(1)
  187.   oldLoginID=user.DBloginID
  188.  
  189.   do until(okToRename)
  190.       do until ( (newLoginID \= "") & (newLoginID \= oldLoginID))
  191.          Say
  192.          Call Charout, "Enter NEW login name : "
  193.          newLoginId=GetString()
  194.          newLoginId=STRIP(newLoginId,"B")
  195.       end
  196.  
  197.       okToRename=TRUE
  198.       if FindUserRecord(newLoginId) then do
  199.         okToRename=FALSE
  200.         Say
  201.         Say "   **** Sorry, user" newLoginId " already exists as "
  202.         call ShowUserNames
  203.       end
  204.  
  205.       if okToRename then do
  206.          Say
  207.          okToRename=GetYesNo("Rename " || oldLoginID|| " to " newLoginID)
  208.       end
  209.  
  210.   end
  211.  
  212.   call parseUser(oldRecord)
  213.  
  214.   call AddAudit("Rename user " || oldLoginID|| " to " newLoginID":")
  215.   Say
  216.   Say
  217.  
  218.   prompt=FALSE
  219.   rc1=DeleteUser(oldRecord, prompt)
  220.  
  221.   say
  222.  
  223.   parse VAR oldRecord oldName '~' remainder
  224.   newRecord=newLoginId || '~' || remainder
  225.  
  226.   newRecord=CreateUser(newRecord)
  227.  
  228.   return
  229.  
  230.  
  231. /* =================================================================== */
  232. /* Create the requested userId */
  233. EditUser:
  234.   oldRecord=ARG(1)
  235.   call ParseUser(oldRecord)
  236.   do i=1 TO numDBFields
  237.      olduser.i=user.i
  238.   end
  239.  
  240.   editRecord=oldRecord
  241.   do UNTIL (GetYesNo("Ok to make changes"))
  242.     editRecord=UserRecordEdit(editRecord)
  243.   end
  244.   if oldRecord=editRecord then do
  245.      Say "Nothing was changed"
  246.   end
  247.   else do
  248.  
  249.      call UpdateRadiusDB("UPDATE")
  250.  
  251.      call AddAudit("Changed user " || user.DBloginID)
  252.  
  253.   end
  254.   RETURN
  255.  
  256.  
  257. /* =================================================================== */
  258. /* Create the requested userId */
  259. CreateUser:
  260.   dbRecord=ARG(1)
  261.  
  262. okToCreate=FALSE
  263. DO WHILE(\okToCreate)
  264.  
  265.   dBRecord=UserRecordEdit(dbRecord)
  266.  
  267.   IF user.DBloginID=user.DBloginPW THEN DO
  268.     Say
  269.     Say "    *****Warning: User login name must be different than the password"
  270.   END
  271.  
  272.   IF LENGTH(user.DBloginID) < 4 THEN DO
  273.     Say
  274.     Say "    *****Warning: User login name should be at least 4 characters"
  275.   END
  276.   IF LENGTH(user.DBloginID) > 13 THEN DO
  277.     Say
  278.     Say "    *****Warning: User login name should be no more than 13 characters (abs. max 16)"
  279.   END
  280.  
  281.   /*  Not needed for our RADIUS
  282.   IF LowerCase(user.DBloginID) \= user.DBloginID THEN DO
  283.     Say "Warning: User login name should be all lower case characters"
  284.   END
  285.   */
  286.  
  287.   IF LENGTH(user.DBloginPW) < 4 THEN DO
  288.     Say
  289.     Say "    *****Warning: Password should be at least 4 characters"
  290.   END
  291.   IF LENGTH(user.DBloginPW) > 13 THEN DO
  292.     say "   Password length is " LENGTH(user.DBloginPW)
  293.     Say "    *****Warning: Password should be no more than 13 characters (abs. max 16)"
  294.   END
  295.   IF LowerCase(user.DBloginPW) \= user.DBloginPW THEN DO
  296.     Say
  297.     Say "    *****Warning: Password should be all lower case characters"
  298.   END
  299.  
  300.   IF POS(TRANSLATE(user.DBloginPW), TRANSLATE(user.DBrealName)) > 0 THEN DO
  301.      Say
  302.      say "   *******  Warning: May not be a very good password!"
  303.      say "            Suggest not using part of their name as a password!!"
  304.   END
  305.  
  306.   okToCreate=GetYesNo('Ok to create user "'||  user.DBloginID || '/' ||,
  307.                     user.DBloginPW ||'", "' || user.DBrealName || '"')
  308.   if \okToCreate THEN DO
  309.     IF \GetYesNo("Re-enter") THEN DO
  310.       EXIT 1
  311.     END
  312.   END
  313.  
  314. END
  315.  
  316. Say
  317.  
  318. call UpdateRadiusDB("ADD")
  319.  
  320. call AddAudit("Add user " || user.DBloginID)
  321.  
  322. return dbRecord
  323.  
  324.  
  325. /* =================================================================== */
  326. DeleteDir:
  327.   delDir=ARG(1)
  328.   description=ARG(2)
  329.   if ExistDir(delDir) THEN DO
  330.     Say "Deleting " description" directory "
  331.     "@rd " delDir " > nul 2>&1"
  332.     IF rc \= 0 THEN DO
  333.       "@deltree " delDir
  334.     END
  335.  
  336.   end
  337.   return 0
  338.  
  339. /* =================================================================== */
  340. RenameDir:
  341.   renDir=ARG(1)
  342.   newDirName=ARG(2)
  343.   description=ARG(3)
  344.  
  345.   renamed=FALSE
  346.   if ExistDir(renDir) THEN DO
  347.     tries=0
  348.     do until(renamed | (tries > 3))
  349.        Call CharOut,  "Renaming " description" directory ..."
  350.        "@ren " renDir newDirName" > nul"
  351.        renamed = (rc=0)
  352.        if \renamed then do
  353.           tries=tries+1
  354.           Say
  355.           say "Problem renaming directory (someone else may be accessing it)"
  356.           call CharOut, "Try #" tries ", Pausing 5 seconds..."
  357.           call SysSleep(5)
  358.           Say
  359.        end
  360.        else do
  361.           say "Success!"
  362.           Say
  363.        end
  364.     end
  365.  
  366.     if tries > 3 then do
  367.       say "Unable to rename directory " || renDir ". Rename it later manually."
  368.       "@pause"
  369.       Say
  370.     end
  371.  
  372.   end
  373.   return renamed
  374.  
  375.  
  376. /* =================================================================== */
  377. AddAudit:
  378.   auditRecord=ARG(1)
  379.   logString=Date("N") || " " || TIME("C") || " " || auditRecord
  380.   auditFile=radDbDir || "Changes.Log"
  381.   linesLeft=LINEOUT(auditFile, logString)
  382.   Error=STREAM(auditFile,C,'CLOSE')
  383.   return
  384.  
  385.  
  386. /* ------------------------------------------------------------------- */
  387. DeleteUser:
  388.   delDbRecord=ARG(1)
  389.   needPrompt=ARG(2)
  390.  
  391.   call ParseUser(delDbRecord)
  392.  
  393.   deleteHimOrHer=TRUE
  394.   if needPrompt then do
  395.      say
  396.      say "*** ====================="
  397.      say "*** Delete user " user.DBloginID
  398.      say
  399.      deleteHimOrHer=GetYesNo("Delete "user.DBloginID", are you Sure")
  400.   end
  401.   if deleteHimOrHer then do
  402.      call UpdateRadiusDB("DELETE")
  403.  
  404.      call AddAudit("Deleted user " || user.DBloginID)
  405.   end
  406.   return 0
  407.  
  408.  
  409.  
  410.  
  411. /* ------------------------------------------------------------------- */
  412. /* WARNING: Any hand-entered RADIUS attributes not recognized by this
  413.    procedure will be discarded.
  414.    Performs the action on the user in the global user.record
  415.  */
  416. UpdateRadiusDB:
  417.    /*
  418.    'DELETE'
  419.    'UPDATE'
  420.    'ADD'
  421.    */
  422.    action=ARG(1)
  423.  
  424.    Error=STREAM(radUserPath,C,'OPEN READ')
  425.    IF Error\="READY:" THEN DO
  426.       Say "Error reading file " || radUserPath
  427.       EXIT 1
  428.    END
  429.  
  430.    lineCount=0
  431.    lastDataLine=0
  432.    userFound=FALSE
  433.  
  434.    DO WHILE (LINES(radUserPath) > 0)
  435.      line=LINEIN(radUserPath)
  436.  
  437.      if POS(user.DBloginID, line) = 1 then do
  438.         /* Delete the user and any qualification RADIUS line(s) */
  439.         testChar=SUBSTR(line, LENGTH(user.DBloginID)+1, 1)
  440.         if (testChar=" ") | (testChar=tab) then do
  441.            do until (testChar \= tab) | (LENGTH(line)=0)
  442.               line=LINEIN(radUserPath)
  443.               testChar=SUBSTR(line, 1, 1);
  444.               if (testChar=" ") | (testChar=tab) then do
  445.                  /* Eat current line and get next: another user? */
  446.                  line=LINEIN(radUserPath)
  447.                  testChar=SUBSTR(line, 1, 1);
  448.               end
  449.            end
  450.         end
  451.  
  452.      end
  453.      lineCount=lineCount+1
  454.      fileLine.lineCount=line
  455.      if LENGTH(line)>0 then do
  456.         /* Allows to strip trailing blank lines */
  457.         lastDataLine=lineCount
  458.      end
  459.  
  460.  
  461.    END
  462.  
  463.    Error=STREAM(radUserPath,C,'CLOSE')
  464.  
  465.    /* Add new record to file and rewrite */
  466.    tmpFile=radDbDir || "Users.new"
  467.  
  468.    call CreateOutputFile(tmpFile)
  469.    do i=1 to lastDataLine
  470.      call WriteToFile(fileLine.i)
  471.    end
  472.    if action\="DELETE"  then do
  473.       radRec=user.DBloginID || tab || 'Password = "' || user.DBloginPW
  474.       radRec=radRec || '", Sessions = '|| user.DBsessionLimit
  475.       call WriteToFile(radRec)
  476.       if user.DBsessionTimeout \= "" then do
  477.          call WriteToFile(tab || "Session-Timeout = " || user.DBsessionTimeout*60)
  478.       end
  479.       if user.DBFixedIP \= "" then do
  480.          call WriteToFile(tab || "Framed-Address = " || user.DBFixedIP)
  481.       end
  482.    end
  483.  
  484.    CALL CloseOutputFile
  485.  
  486.    bakFile="users.BAK"
  487.    bakFileSpec=radDBDir || bakFile
  488.  
  489.  
  490.    "@protren \sem32\radiusd\users "tmpFile || " " || radUserPath || " " || bakFileSpec
  491.    /*
  492.      ProtRen does same as following 3 lines except for Semaphore intelock:
  493.    result=SysFileDelete(bakFileSpec)
  494.    "@ren " || radUserPath || " " || bakFile
  495.    "@ren " || tmpFile || " " radUserFile
  496.    **** */
  497.  
  498.  
  499.     IF (rc = 0) THEN DO
  500.      say "RADIUS database updated; User has been "action"'d"
  501.     END
  502.     ELSE DO
  503.       IF \GetYesNo("Problem updating RADIUS database.  Continue") THEN DO
  504.         EXIT 1
  505.       END
  506.     END
  507.  
  508.  
  509.   RETURN
  510.  
  511.  
  512.  
  513.  
  514. /* ------------------------------------------------------------------- */
  515. CreateOutputFile: PROCEDURE EXPOSE OutputFile
  516.   OutputFile=ARG(1)
  517.   result=SysFileDelete(OutputFile)
  518.   Error=STREAM(OutputFile,C,'OPEN WRITE')
  519.   IF Error\="READY:" THEN Bomb("Error " || Error || "creating file ",
  520.           || OutputFile)
  521.  
  522.   RETURN
  523.  
  524.  
  525. /* ------------------------------------------------------------------- */
  526. WriteToFile: PROCEDURE EXPOSE OutputFile
  527.   outputData=ARG(1)
  528.   linesLeft=LINEOUT(OutputFile, outputData)
  529.   IF linesLeft > 0 THEN DO
  530.     Bomb("Error writing to " || OutputFile)
  531.   END
  532.   RETURN
  533.  
  534.  
  535. /* ------------------------------------------------------------------- */
  536. CloseOutputFile: PROCEDURE EXPOSE OutputFile
  537.   Error=STREAM(OutputFile,C,'CLOSE')
  538.   IF Error\="READY:" THEN Bomb("Error " || Error || "closing file ",
  539.           || OutputFile)
  540.  
  541.   RETURN
  542.  
  543.  
  544.  
  545. /* ------------------------------------------------------------------- */
  546. ExistDir: PROCEDURE EXPOSE TRUE FALSE
  547. directory=ARG(1)
  548.  
  549.   rc = SysFileTree(directory,stemRes,'D',,);
  550.   IF stemRes.0=1 THEN RETURN TRUE
  551.   ELSE RETURN FALSE
  552.  
  553.  
  554.  
  555. /* ------------------------------------------------------------------- */
  556. ExistFile: PROCEDURE EXPOSE TRUE FALSE
  557. filename=ARG(1)
  558.  
  559.   /* Check that the input file exists */
  560.   IF (STREAM(filename,C,'QUERY EXISTS')="" ) THEN RETURN FALSE
  561.   ELSE RETURN TRUE
  562.  
  563.  
  564.  
  565.  
  566.  
  567. /* ------------------------------------------------------------------- */
  568. BOMB: PROCEDURE EXPOSE LogFile TRUE FALSE
  569.   reason=ARG(1)
  570.   Say ""
  571.  
  572.   Say  "Terminating.." reason
  573.   EXIT 1
  574.  
  575.  
  576. /* ------------------------------------------------------------------- */
  577. GetYesNo: PROCEDURE Expose interactive
  578.  
  579.   prompt=ARG(1)
  580.  
  581.  
  582.   IF \Interactive THEN DO
  583.     Say "RADUSER: Aborting in non-interactive mode.  Would have blocked "
  584.     Say "while asking the question ("prompt"? )"
  585.     EXIT 1
  586.   END
  587.  
  588.  
  589.   CALL CharOut , prompt '? (Y/N): '
  590.  
  591. DO UNTIL ( (key='Y') | (key='N') )
  592.   parse upper value SysGetKey('NOECHO') with key
  593.   /* Check for ESCAPE */
  594.   IF key='1B'X THEN EXIT 1
  595. END
  596.  
  597. Say key
  598. RETURN (key='Y')
  599.  
  600.  
  601. /* ===================================================================
  602.   DATABASE definition procedures: MODIFY ALL when modifying database
  603.   definition!
  604.    ------------------------------------------------------------------- */
  605. DeclareDatabase:
  606.  
  607.  
  608.   DBVarName.1='DBloginId'
  609.   DBVarName.2='DBloginPW'
  610.   DBVarName.3='DBsessionLimit'
  611.   DBVarName.4='DBsessionTimeout'
  612.   DBVarName.5='DBFixedIP'
  613.  
  614.   /* Update when adding a new field!!! */
  615.   numDBFields = 5
  616.  
  617.   /* Assign numbers to database field names */
  618.   do i=1 TO numDBFields
  619.      cmd=DBVarName.i"="i
  620.      INTERPRET cmd
  621.   end
  622.  
  623.  
  624.   RETURN
  625.  
  626.  
  627. /* -------------------------------------------------------------------
  628.   Return a default user record, given the login ID
  629.   ------------------------------------------------------------------- */
  630. DefaultDbRecord: PROCEDURE
  631.   userId=ARG(1)
  632.   newRecord=userID || "~*~2~~~~~"
  633.   RETURN newRecord
  634.  
  635.  
  636. /* -------------------------------------------------------------------
  637.   END DATABASE definition procedures.
  638.   =================================================================== */
  639.  
  640.  
  641.  
  642.  
  643. /* ------------------------------------------------------------------- */
  644. LoadUserDatabase:
  645.   Error=STREAM(radUserPath,C,'OPEN READ')
  646.   IF Error\="READY:" THEN DO
  647.      Say "Error reading file " || radUserPath
  648.      EXIT 1
  649.   END
  650.  
  651.   userCount=0
  652.  
  653.   haveLine=FALSE
  654.   DO WHILE (LINES(radUserPath) > 0)
  655.     IF \haveLine THEN DO
  656.       line=LINEIN(radUserPath)
  657.       testChar=SUBSTR(line, 1, 1);
  658.     END
  659.     haveLine=FALSE
  660.     IF (LENGTH(line) > 3) & (testChar \= '#') THEN DO
  661.  
  662.        user.=""
  663.        /* Translate tab to space so parse will work */
  664.        line=TRANSLATE(line, " ", tab)
  665.        PARSE VAR line user.DBLoginID . '= "' user.DBLoginPW'", Sessions = 'user.DBSessionLimit
  666.  
  667.        line=LINEIN(radUserPath)
  668.  
  669.        testChar=SUBSTR(line, 1, 1)
  670.        haveData=TRUE
  671.        DO WHILE ((testChar==" ") | (testChar=tab)) & haveData
  672.          PARSE VAR line . "Session-Timeout = "timeout
  673.          timeout=STRIP(timeout)
  674.          IF timeout\="" THEN DO
  675.            user.DBsessionTimeout=timeout
  676.          END
  677.          PARSE VAR line . "Framed-Address = "addr
  678.          addr=STRIP(addr)
  679.          IF addr\="" THEN DO
  680.            user.DBFixedIP=addr
  681.          END
  682.          IF LINES(radUserPath)=0 THEN DO
  683.            haveData=FALSE
  684.          END
  685.          line=LINEIN(radUserPath)
  686.          testChar=SUBSTR(line, 1, 1);
  687.        end
  688.  
  689.  
  690.        IF (user.DBLoginID \= "DEFAULT") & (user.DBLoginID \= "DEFAULT.ppp") THEN DO
  691.          userCount=userCount+1
  692.          masterDB.userCount=MakeDBRecord()
  693.        END
  694.        haveLine=TRUE
  695.     END
  696.  
  697.  
  698.   END
  699.  
  700.   Error=STREAM(radUserPath,C,'CLOSE')
  701.  
  702.   masterDB.dbLineCount=userCount
  703.  
  704.   RETURN
  705.  
  706.  
  707.  
  708.  
  709. /* -------------------------------------------------------------------
  710.   Reverse of ParseUserRecord above; reassemble
  711.      'user.' into a database record and RETURN it
  712.   ------------------------------------------------------------------- */
  713. MakeDBRecord:
  714.   retString=""
  715.   do parseField=1 TO numDBFields
  716.      retString=retString || user.parseField || '~'
  717.   end
  718.  
  719.   RETURN retString
  720.  
  721.  
  722.  
  723. /* -------------------------------------------------------------------
  724.   Search user database in memory for the passed userId record.
  725.   **** Modifies the global user. database record *********
  726.   RETURN TRUE if found with user information in global user database record.
  727.   ------------------------------------------------------------------- */
  728. FindUserRecord:
  729.   userId=LowerCase(ARG(1))
  730.   i=1
  731.   found=FALSE
  732.   do WHILE (i<=masterDB.dbLineCount) & \found
  733.     call ParseUser(masterDB.i)
  734.     if userId=LowerCase(user.DBloginID) then do
  735.       found=TRUE
  736.     end
  737.     i=i+1
  738.   end
  739.  
  740.  
  741.   RETURN found
  742.  
  743.  
  744.  
  745. /* -------------------------------------------------------------------
  746.   Show the record fields for current 'user.'
  747.   ------------------------------------------------------------------- */
  748. ShowSettings:
  749.  
  750. /*
  751. login ID:
  752. login PW:
  753. Session Limit   : 1           
  754. Session Timeout : 0
  755. Fixed IP        :
  756. */
  757.   Say
  758.   say "-------------------------Current Settings ---------------"
  759.   say "login ID: "user.DBloginID
  760.   say "login PW: "user.DBloginPW
  761.   say "Session Limit   : "user.DBsessionLimit
  762.   CALL CHAROUT, "Session Timeout : "
  763.   IF user.DBsessionTimeout \= "" THEN DO
  764.     Say user.DBsessionTimeout/60" Minutes"
  765.   END
  766.   ELSE DO
  767.     Say
  768.   END
  769.   say "Fixed IP           : "user.DBFixedIP
  770.  
  771.   say "---------------------------------------------------------"
  772.  
  773.   RETURN
  774.  
  775.  
  776.  
  777.  
  778. /* -------------------------------------------------------------------
  779.   Get a string, accepting F10 and setting boolean 'moreEdit'
  780.   ------------------------------------------------------------------- */
  781. GetString:
  782.    newString=""
  783.    do while (1)
  784.       key = SysGetKey("noecho")
  785.       d2ckey = C2D(key)
  786.  
  787.       SELECT
  788.          WHEN d2ckey = 13 THEN      /* Carriage-return was pressed */
  789.             DO
  790.                moreEdit=TRUE
  791.                Say
  792.                if newString==" " then do
  793.                   /* Return tilde.  It will be stripped out, thus
  794.                      creating a blank string to replace the old string. */
  795.                   newString="~"
  796.                end
  797.                RETURN newString
  798.             END
  799.  
  800.          WHEN d2ckey = 8 THEN       /* Backspace pressed */
  801.             DO
  802.                IF length(newString) > 0 THEN DO
  803.                  call CharOut, "08"x "08"x
  804.                  newLen=LENGTH(newString)-1
  805.                  newString=SUBSTR(newString, 1, newLen)
  806.                END
  807.             END
  808.  
  809.          WHEN d2ckey = 27 THEN DO     /* ESCape was pressed, abort */
  810.             Say
  811.             exit 1
  812.          END
  813.  
  814.          WHEN d2ckey = 224 | d2ckey = 0 THEN   /* escape-sequence in hand ? */
  815.             DO
  816.                key2 = SysGetKey("noecho")       /* get next code */
  817.                d2ckey2 = C2D(key2)
  818.  
  819.                IF d2ckey2 = 68 THEN do    /* F10 was pressed, save */
  820.                  moreEdit=FALSE
  821.                  say
  822.                  RETURN newString
  823.                END
  824.             END
  825.          WHEN (d2ckey>=32) & (d2ckey <= 127) THEN
  826.             DO
  827.                newString=newString || key
  828.                call CharOut, key
  829.             END
  830.  
  831.       END
  832.    end
  833.    RETURN ""
  834.  
  835.  
  836. /* -------------------------------------------------------------------*/
  837. EditString:
  838.   recNum=ARG(1)
  839.   prompt=ARG(2)
  840.   call CharOut, Prompt "<"user.recNum">: "
  841.   testStr=GetString()
  842.   if testStr \= "" then do
  843.      user.recNum=testStr
  844.   end
  845.   return ""
  846.  
  847.  
  848. /* -------------------------------------------------------------------*/
  849. EditBool:
  850.   moreEdit=TRUE
  851.   recNum=ARG(1)
  852.   prompt=ARG(2)
  853.   if user.recNum then do
  854.      default="Y"
  855.   end
  856.   else do
  857.      default="N"
  858.   end
  859.   call CharOut, Prompt "(Y/N) <"default">: "
  860.  
  861.    DO UNTIL ( (key='Y') | (key='N') | (key='0D'x) )
  862.      parse upper value SysGetKey('NOECHO') with key
  863.      /* Check for ESCAPE */
  864.      IF key='1B'X THEN EXIT 1
  865.      IF key='00'X THEN DO
  866.          key2 = SysGetKey("noecho")       /* get next code */
  867.          d2ckey2 = C2D(key2)
  868.  
  869.          IF d2ckey2 = 68 THEN do    /* F10 was pressed, save */
  870.            moreEdit=FALSE
  871.            key="0D"x
  872.          END
  873.      END
  874.    END
  875.  
  876.    if key="Y" then do
  877.      user.recNum=TRUE
  878.    end
  879.    if key="N" then do
  880.      user.recNum=FALSE
  881.    end
  882.  
  883.   Say key
  884.   return ""
  885.  
  886. /* -------------------------------------------------------------------*/
  887. EditEnum:
  888.   moreEdit=TRUE
  889.   recNum=ARG(1)
  890.   prompt=ARG(2)
  891.   say
  892.   validChoices="0D"x
  893.   do i=1 to DBenumCount.recNum
  894.      Call CharOut, "<" || DBenumString.recNum.i || "> - "
  895.      validChoices=validChoices || DBenumString.recNum.i
  896.      Say DBenumDescr.recNum.i
  897.   end
  898.   call CharOut, tab Prompt ": <"user.recNum">: "
  899.  
  900.    DO UNTIL ( POS(key, validChoices) > 0)
  901.      parse upper value SysGetKey('NOECHO') with key
  902.      /* Check for ESCAPE */
  903.      IF key='1B'X THEN EXIT 1
  904.      IF key='00'X THEN DO
  905.          key2 = SysGetKey("noecho")       /* get next code */
  906.          d2ckey2 = C2D(key2)
  907.  
  908.          IF d2ckey2 = 68 THEN do    /* F10 was pressed, save */
  909.            moreEdit=FALSE
  910.            key="0D"x
  911.          END
  912.      END
  913.    END
  914.  
  915.    if key \= "0D"x then do
  916.      user.recNum=key
  917.    end
  918.  
  919.   Say key
  920.   Say
  921.   return ""
  922.  
  923. /* -------------------------------------------------------------------
  924.   Edit the database fields in 'user.'
  925.   ------------------------------------------------------------------- */
  926. UserRecordEdit:
  927.  
  928.   recToEdit=ARG(1)
  929.   call ParseUser(recToEdit)
  930.  
  931.   call ShowSettings
  932.   Say
  933.   Say "Edit record for Login Id "user.DBloginId
  934.   Say "  (F10 to accept remaining fields)"
  935.   x=EditString(dbloginPW, "Login Password")
  936.  
  937.   if moreEdit then
  938.     x=EditString(DBSessionLimit, "Max simultaneous logins")
  939.  
  940.   IF user.dbSessionTimeout \= "" THEN DO
  941.     user.dbSessionTimeout=user.DBSessionTimeout / 60
  942.   END
  943.   if moreEdit then
  944.     x=EditString(DBSessionTimeout, "Max logon time (blank or 0 for unlimited)")
  945.  
  946.   if moreEdit then
  947.     x=EditString(DBFixedIP, "Fixed IP Address (blank for dynamic)")
  948.  
  949.   do stripField=1 TO numDBFields
  950.     user.stripField=STRIP(user.StripField,"B")
  951.     DO WHILE POS('~', user.stripField) > 0
  952.        user.stripField = DELSTR(user.stripField, POS('~', user.stripField), 1)
  953.     END
  954.   end
  955.  
  956.   if DATATYPE(user.DBsessionTimeout)\="NUM" then do
  957.     user.DBSessionTimeout=""
  958.   end
  959.   else do
  960.      user.dbSessionTimeout=user.DBSessionTimeout * 60
  961.      if user.DBsessionTimeout=0 then do
  962.        user.DBSessionTimeout=""
  963.      end
  964.   end
  965.  
  966.   call ShowSettings
  967.   RETURN MakeDBRecord()
  968.  
  969.  
  970. /* -------------------------------------------------------------------
  971.   Parse the passed database record to the compound variable
  972.      'user.'
  973.   ------------------------------------------------------------------- */
  974. ParseUser:
  975.   dbRecord=ARG(1)
  976.   rawdbRecord=ARG(1)
  977.   do parseField=1 TO numDBFields
  978.      parse VAR dbRecord user.parseField '~' dbRecord
  979.   end
  980.  
  981.   if DATATYPE(user.DBsessionLimit)\="NUM" then do
  982.      say "Database record is corrupt- Non-numeric session limit-"
  983.      say rawdbRecord
  984.      EXIT 1
  985.   end
  986.  
  987.   if (user.DBsessionLimit < 0) | (user.DBsessionLimit > 20) then do
  988.      say "Database record is corrupt: Bogus session limit-" user.DBsessionLimit
  989.      say rawdbRecord
  990.      EXIT 1
  991.   end
  992.  
  993.   if POS("~", user.numDBFields) > 0 THEN DO
  994.      say "Database record is corrupt: too many fields in-"
  995.      say rawdbRecord
  996.      EXIT 1
  997.   end
  998.  
  999.   RETURN
  1000.  
  1001.  
  1002. /* =================================================================== */
  1003. StringToEnum:
  1004.   index=ARG(1)
  1005.   retStr="A"
  1006.   do enumIndex=1 TO DBenumCount.index
  1007.      if DBenumDescr.index.enumIndex=user.index then do
  1008.         retStr=DBenumString.index.enumIndex
  1009.      end
  1010.   end
  1011.   return retStr
  1012.  
  1013. /* =================================================================== */
  1014. EnumToString:
  1015.   index=ARG(1)
  1016.   retStr=DBenumDescr.1
  1017.   do enumIndex=1 TO DBenumCount.index
  1018.      if DBenumString.index.enumIndex=user.index then do
  1019.         retStr=DBenumDescr.index.enumIndex
  1020.      end
  1021.   end
  1022.   return retStr
  1023.  
  1024.  
  1025.  
  1026.  
  1027. /* ------------------------------------------------------------------- */
  1028. LowerCase: PROCEDURE
  1029.  
  1030.   string=ARG(1)
  1031.   lowString=TRANSLATE(string, "abcdefghijklmnopqrstuvwxyz",,
  1032.                               "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1033.  
  1034.   RETURN (lowString)
  1035.  
  1036.  
  1037.