home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / netdor3.zip / DISK_12 / IMAGE11.ZIP / ADMTOOLS / SRVINIT.CMD < prev    next >
OS/2 REXX Batch file  |  1994-11-25  |  44KB  |  1,212 lines
  1. /*****************************************************************************
  2.  *                        SRVINIT - Start COU Server                         *
  3.  *                     CORE Development (CORE at WATSON)                     *
  4.  *****************************************************************************
  5.  *                    Licensed Materials-Property of IBM                     *
  6.  *               5604-472 (c) Copyright IBM Corporation, 1993                *
  7.  *                           All rights reserved.                            *
  8.  *                  US Government Users Restricted Rights -                  *
  9.  *                 Use, duplication or disclosure restricted                 *
  10.  *                by GSA ADP Schedule Contract with IBM Corp.                *
  11.  *****************************************************************************
  12.  * Dependencies:                                                             *
  13.  * RXUTILS                                                                   *
  14.  *****************************************************************************
  15.  * Change History:                                                           *
  16.  * (Earlier changes can be found in \COREUTIL\HISTORY\CSRVUP.HST)            *
  17.  * Version 3.0 - 22 Mar 93                                                   *
  18.  * - New assumptions for product:                                            *
  19.  *   - Appropriate network protocol(s) is/are started.                       *
  20.  *   - User has been logged on.                                              *
  21.  *   - Remote drive is accessed.                                             *
  22.  *****************************************************************************/
  23.  
  24. /* Note
  25.  * Need to erase MTAB file on reboot if NFS server
  26.  */
  27. trace 'O'
  28. TrVal = value('CORETRACE',,'OS2ENVIRONMENT')
  29. if TrVal = '' then TrVal = 'O'
  30. trace value TrVal
  31. call   on halt
  32. signal on novalue
  33. signal on syntax
  34. '@ECHO OFF'
  35.  
  36. PgmVer = '3.0'
  37. Globals = 'CDr UDr TrVal Ctl. Opt. File. Msg.'
  38. parse upper source . . File.!Me
  39. parse value stream(File.!Me, 'C', 'QUERY DATETIME') with PgmDate .
  40.  
  41. parse upper arg Args
  42. call SetMsgClass 'M', 'X'
  43. if wordpos('/DEBUG', Args) > 0
  44.   then call Debug
  45.  
  46. parse var Args PosParms '/' SlashParms
  47. if PosParms <> ''
  48.   then signal Tell
  49.  
  50. /*
  51.  * Check what version of REXX is running, and abort or warn if neccessary.
  52.  * REXXVER specifies the minimum version of REXX required.
  53.  * REXXMIN specifies the minimum release date of REXX required.
  54.  * REXXCURR specifies the current release of REXX; preferred.
  55.  */
  56. RexxVer  = '4.00'                      /* Required REXX version */
  57. RexxMin  = '16 Aug 1991'               /* Minimum req'd REXX date */
  58. RexxCurr = '16 Aug 1991'               /* Desired REXX date */
  59. RxUtilsMin = 1.71                      /* Minimum RXUTILS version */
  60. Msg.!Min   = 2.14                      /* Minimum message file version */
  61.  
  62. parse upper version . . RelDay RelMo RelYr .
  63. if DateLess(RelDay RelMo RelYr, RexxMin)    /* Old REXX running */
  64.   then call Report 3501, RexxVer, RelDay RelMo RelYr, RexxCurr
  65. if DateLess(RelDay RelMo RelYr, RexxCurr)   /* Middling old REXX */
  66.   then call Report 3502, RexxVer, RelDay RelMo RelYr, RexxCurr
  67.  
  68. /*****************************************************************************
  69.  *                                MAIN PROGRAM                               *
  70.  *****************************************************************************/
  71. call Initialize
  72. call StartNetwork
  73. call GetAuxAliases
  74. call StartPrograms
  75. call UpdateLocal
  76. call LastTasks
  77. call CleanUp 0
  78. exit 254                               /* This exit should never happen! */
  79.  
  80. /*****************************************************************************
  81.  *                         GENERAL PURPOSE ROUTINES                          *
  82.  *****************************************************************************/
  83.  
  84. /*****************************************************************************
  85.  * DATELESS: Date1, Date2                                                    *
  86.  * Returns 1 if Date1 is "less than" (earlier than) Date 2.  Dates are in    *
  87.  * REXX normal (14 Mar 1964) format.                                         *
  88.  *****************************************************************************/
  89. DateLess: procedure expose (Globals)
  90. trace 'O';call Report 9996, 'DateLess' arg(1)','arg(2)
  91. trace 'O'
  92. parse upper arg D1 M1 Y1, D2 M2 Y2
  93. Months='JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC'
  94. M1 = right(wordpos(M1, Months), 2, 0)
  95. M2 = right(wordpos(M2, Months), 2, 0)
  96. return ShowReturn(right('19'Y1, 4) || M1 || D1 < right('19'Y2, 4) || M2 || D2)
  97.  
  98. /*****************************************************************************
  99.  * INIGET                                                                    *
  100.  * Retrieves information from INI files, mapping error returns to null.      *
  101.  *****************************************************************************/
  102. IniGet: procedure expose (Globals)
  103. trace 'O';call Report 9996, 'IniGet' arg(1)',' arg(2)',' arg(3)
  104. trace 'O'
  105. parse arg File, App, Key
  106. Res = rxOs2Ini(File, App, Key)
  107. if wordpos(Res, '$RXERROR $INIERROR $INI_ERROR') | abbrev(Res, 'ERROR:')
  108.   then Res = ''
  109.   else Res = strip(Res, 'T', '0'x)
  110. return ShowReturn(Res)
  111.  
  112. /*****************************************************************************
  113.  * NORMALIZE dir                                                             *
  114.  * Convert the input directory into standard format:                         *
  115.  * - Remove any trailing backslash if not root drive.                        *
  116.  *****************************************************************************/
  117. Normalize:
  118. trace 'O';call Report 9996, 'Normalize' arg(1)','arg(2)
  119. trace value 'O'
  120. parse arg Dir, Opt
  121. if length(Dir) > 3
  122.   then Dir = strip(Dir, 'T', '\')
  123. if Opt = 'CORE' & right(Dir, 1) <> '\'
  124.   then Dir = Dir'\'
  125. return ShowReturn(Dir)
  126.  
  127. /*****************************************************************************
  128.  * CHECKDRIVE                                                                *
  129.  * OK FREE - Arg is valid drive letter and is free                           *
  130.  * OK USED - Arg is valid drive letter and in use                            *
  131.  * BAD    - Arg is invalid drive specification                               *
  132.  *****************************************************************************/
  133. CheckDrive: procedure expose (Globals)
  134. trace 'O';call Report 9996, 'CheckDrive' arg(1)
  135. trace value TrVal
  136. parse arg Dr
  137. signal on syntax name CheckDrive2
  138. if rxDriveInfo(Dr) = ''
  139.   then return ShowReturn('OK FREE')
  140.   else return ShowReturn('OK USED')
  141.  
  142. CheckDrive2:
  143. if rc = 40
  144.   then return ShowReturn('BAD')
  145.   else call Syntax '<WHERE>', SigL
  146.  
  147. /*****************************************************************************
  148.  * CHECKPATH                                                                 *
  149.  * Path must be fully qualified.                                             *
  150.  * OK FREE - Arg is a valid path that does not exist.                        *
  151.  * OK USED - Arg is a valid path that exists.                                *
  152.  * BAD     - Path is invalid.                                                *
  153.  *****************************************************************************/
  154. CheckPath: procedure expose(Globals)
  155. trace 'O';call Report 9996, 'CheckPath' arg(1)
  156. trace value TrVal
  157. InPath = Normalize(arg(1))
  158. parse var InPath Dr +2 Sl +1 Path
  159. Res = CheckDrive(Dr)
  160. if Res <> 'BAD'
  161.   then if Sl <> '\'
  162.     then Res = 'BAD'
  163.     else do while Path <> '' & Res <> 'BAD'
  164.       parse var Path Dir '\' Path
  165.       if Dir = ''
  166.         then Res = 'BAD'
  167.     end
  168. if Res <> 'BAD'
  169.   then if rxDirExist(InPath)
  170.     then Res = 'OK USED'
  171.     else Res = 'OK FREE'
  172. return ShowReturn(Res)
  173.  
  174. /*****************************************************************************
  175.  * DRIVEREADABLE                                                             *
  176.  * Return 1 if specified drive (or directory) is readable                    *
  177.  *****************************************************************************/
  178. DriveReadable: procedure expose (Globals)
  179. trace 'O';call Report 9996, 'DriveReadable' arg(1)
  180. trace value TrVal
  181. Dr = strip(arg(1), 'T', '\')
  182. UC = 'ABCDEFGHIJKLMNOPQRSTUVQXYZ'
  183. parse value 0 with Ok 1 Files 1 Dir 1 DirFound .
  184. do until Ok | UC = ''
  185.   parse var UC Letter +1 UC
  186.   call rxTree Dr'\'Letter'*', 'DIR.', 'B'
  187.   if Dir.0 > 0
  188.     then do I = 1 to Dir.0 until Ok
  189.       if pos('D', word(Dir.I, 4)) > 0
  190.         then do
  191.           DirFound = 1
  192.           Files = 1
  193.           call rxTree subword(Dir.I, 5)'\*', 'SUB.', 'F'
  194.           Dir = (Sub.0 <> 0)
  195.         end
  196.         else Files = 1
  197.       Ok = Dir & Files
  198.     end I
  199.     if \DirFound
  200.       then Ok = Files
  201. end
  202. return ShowReturn(Ok)
  203.  
  204. /**::CLAM::1.05::*************************************************************
  205.  *                      CORE Log and Message subsystem                       *
  206.  * Globals = 'MSG.'                                                          *
  207.  *****************************************************************************/
  208.  
  209. /*****************************************************************************
  210.  * REPORT MsgNumb[Flags] [, MArg] [...]                                      *
  211.  *  Flags: S - Write to supplemental log file (must be previously opened)    *
  212.  *         or 1 MsgType override:                                            *
  213.  *           F - Fatal error                                                 *
  214.  *           E - Error                                                       *
  215.  *           W - Warning                                                     *
  216.  *           I - Informational message                                       *
  217.  *           M - Message                                                     *
  218.  *           D - Message (display only)                                      *
  219.  *           L - Message (log only)                                          *
  220.  *           X - Debug message                                               *
  221.  *****************************************************************************/
  222. Report: procedure expose (Globals)
  223. trace value 'O'
  224. if symbol('MSG.!PEND.0') = 'LIT'
  225.   then do
  226.     Esc = d2c(27)'['                  /* Escape character (temp) */
  227.     Msg.!Pend.0 = 0                   /* Pending message stack */
  228.     Msg.!Dull = Esc'0m'               /* Dull white on black */
  229.     Msg.!Norm = Esc'1;37;40m'         /* Intense white on black */
  230.     Msg.!Warn = Esc'0;30;43m'         /* Black on yellow */
  231.     Msg.!Err  = Esc'1;31;47m'         /* Intense red on white */
  232.     Msg.!Eeol = Esc'K'Msg.!Norm       /* Erase to end of line */
  233.     Msg.!Popup = 0                    /* Use DBOXMGR to display warnings */
  234.     Msg.!PopList = 'FEW'              /* Classes to popup if Popup = 1 */
  235.     Msg.!ClassLst = 'FEWIMDLX'
  236.     Msg.!ClassMap = '00246669'
  237.     if symbol('MSG.!DISPSET') = 'LIT'
  238.       then parse value 'I M' with Msg.!DispSet Msg.!LogSet .
  239.     call InitMsgs
  240.   end
  241. parse value '' with Flags Sev
  242. LogNum = 1
  243. MsgN = arg(1)
  244. P = verify(MsgN, '0123456789')
  245. if P > 0
  246.   then if P = 1
  247.     then do
  248.       Flags = MsgN
  249.       MsgN = ''
  250.     end
  251.     else do
  252.       Flags = substr(MsgN, P)
  253.       MsgN = left(MsgN, P-1)
  254.     end
  255. if MsgN = ''
  256.   then do
  257.     Sev = 'L'
  258.     Msg = arg(2)
  259.   end
  260.   else if symbol('MSG.'MsgN) = 'VAR'
  261.     then parse var Msg.MsgN Sev Msg
  262.     else do
  263.       Msg = 'Text for message number' MsgN||Sev 'not found.'
  264.       MsgN = '9999'
  265.       Sev = 'W'
  266.     end
  267. do while Flags <> ''
  268.   parse var Flags 1 Flag 2 Flags
  269.   select
  270.     when Flag = 'S'
  271.       then LogNum = 2
  272.     when verify(Flag, Msg.!ClassLst) = 0
  273.       then Sev = Flag
  274.     otherwise do
  275.       say 'Error - Invalid message flag "'Flag'".'
  276.       call Cleanup 3
  277.     end
  278.   end
  279. end
  280.  
  281. SayIt = Sev <> 'L' & (translate(Sev, Msg.!ClassMap, Msg.!ClassLst) <=,
  282.     translate(Msg.!DispSet, Msg.!ClassMap, Msg.!ClassLst))
  283. LogIt = Sev <> 'D' & (translate(Sev, Msg.!ClassMap, Msg.!ClassLst) <=,
  284.     translate(Msg.!LogSet, Msg.!ClassMap, Msg.!ClassLst))
  285. if rxUtilsVer() >= 1.70
  286.   then SayIt = SayIt & rxProcessType() <> 4
  287.  
  288. if \(SayIt | LogIt)
  289.   then return 0
  290.  
  291. if abbrev(Msg, '->') | abbrev(Msg, '<-')
  292.   then Msg = '['time('S')']' Msg
  293. if \rxfuncquery('RXINSMESSAGE')
  294.   then Msg = rxInsMessage(Msg, arg(2), arg(3), arg(4), arg(5), arg(6), arg(7),,
  295.       arg(8), arg(9), arg(10))
  296.   else do I = 1 to 9
  297.     P = pos('%'I, Msg)
  298.     if P > 0
  299.       then do
  300.         L = length('%'I)
  301.         Msg = left(Msg, P-1)||arg(I+1)||substr(Msg, P+L)
  302.       end
  303.   end
  304. if abbrev(Msg, '->') | abbrev(Msg, '<-')
  305.   then Msg = '['time('S')']' Msg
  306. if MsgN <> ''
  307.   then Msg = 'COR'right(MsgN, 4, '0')||Sev Msg
  308.  
  309. if SayIt
  310.   then if Msg.!PopUp & pos(Sev, Msg.!PopList) > 0
  311.     then call PopUp Msg, Sev
  312.     else call FlowSay Msg, Sev
  313. if LogIt
  314.   then if symbol('Msg.!LOG.1') = 'VAR'
  315.     then do
  316.       Temp.1 = Msg
  317.       Temp.0 = 1
  318.       call rxWrite Msg.!Log.LogNum, 'TEMP.',,,'A'
  319.     end
  320.     else if rxfuncquery('RXSTEMINSERT')
  321.       then do
  322.         Msg.!Pend.0 = Msg.!Pend.0 + 1
  323.         call value 'Msg.!PEND.'Msg.!Pend.0, Msg
  324.       end
  325.       else call rxStemInsert 'Msg.!PEND.', Msg.!Pend.0 + 1, Msg
  326.  
  327. if Sev = 'F'
  328.   then do
  329.     if symbol('Msg.!LOG.1') = 'VAR'
  330.       then do
  331.         say Msg.!Norm'Do you want to view the log file (Y/N)?'
  332.         do forever
  333.           parse upper linein Resp .
  334.           if abbrev('YES', Resp)
  335.             then do
  336.               Res = stream(Msg.!Log.1, 'C', 'CLOSE')
  337.               if \(abbrev(Res, 'READY') | Res = '')
  338.                 then call Report 10, Res, Msg.!Log.1
  339.               'START "CORE Log" /F E' Msg.!Log.1
  340.               leave
  341.             end
  342.           if abbrev('NO', Resp)
  343.             then do
  344.               say 'The log file is in' Msg.!Log.1
  345.               leave
  346.             end
  347.           if abbrev('DEBUG', Resp)
  348.             then signal DebugExit '<SKIP>'
  349.         end
  350.       end
  351.     call CleanUp 2
  352.   end
  353. return 0
  354.  
  355. /*****************************************************************************
  356.  * SETMSGCLASS DisplayClass, LogClass                                        *
  357.  *****************************************************************************/
  358. SetMsgClass: procedure expose (Globals)
  359. trace value 'O'
  360. parse arg Msg.!DispSet ., Msg.!LogSet .
  361. return 0
  362.  
  363. /*****************************************************************************
  364.  * CLINITLOG LogName [Erase], [SecondaryLog [Erase]]                         *
  365.  *****************************************************************************/
  366. ClInitLog: procedure expose (Globals)
  367. trace value 'O'
  368. parse arg Msg.!Log.1 Erase.1, Msg.!Log.2 Erase.2
  369. do I = 1 to arg()
  370.   if Erase.I = 1 & rxFileExist(Msg.!Log.I)
  371.     then do
  372.       RetC = rxDelete(Msg.!Log.I)
  373.       if RetC <> 0
  374.         then call Report '9999W', RetC, Msg.!Log.1   /* error deleting file */
  375.     end
  376. end
  377. call rxWrite Msg.!Log.1, 'Msg.!PEND.',,,'A'
  378. return 0
  379.  
  380. /*****************************************************************************
  381.  * POPUP                                                                     *
  382.  *****************************************************************************/
  383. Popup: procedure expose (Globals)
  384. trace value 'O'
  385. parse arg Msg, Style
  386. call RegExtFuncs
  387. call 'DBoxMgr'
  388. select
  389.   when Style = 'INFO'
  390.     then Style = MB_INFORMATION
  391.   when Style = 'ERROR'
  392.     then Style = MB_ERROR
  393.   when Style = 'WARNING'
  394.     then Style = MB_WARNING
  395.   when Style = 'NONE'
  396.     then Style = MB_ICONNOICON
  397.   otherwise
  398.     Style = MB_WARNING
  399. end
  400. Dlg = dBoxCreate('CORE Message', 0, 0, 0, 0)
  401. call dBoxCreateMbx Dlg, Msg, MB_OK + MB_MOVEABLE + Style
  402. call dBoxDestroy Dlg
  403. return 0
  404.  
  405. /*****************************************************************************
  406.  * FLOWSAY Msg, AnsiPre, AnsiPost                                            *
  407.  * Display the message, breaking it on word boundries into lines less than   *
  408.  * or equal to LLeng.                                                        *
  409.  *****************************************************************************/
  410. FlowSay: procedure expose (Globals)
  411. trace value 'O'
  412. parse arg Msg, Sev
  413. if rxfuncquery('RXSCREENSIZE')
  414.   then LLeng = 80
  415.   else parse value rxScreenSize() with ',' LLeng .
  416.  
  417. call MsgTune Sev
  418. select
  419.   when Sev = 'E' | Sev = 'F'
  420.     then AnsiPre = Msg.!Err
  421.   when Sev = 'W'
  422.     then AnsiPre = Msg.!Warn
  423.   otherwise AnsiPre = Msg.!Norm
  424. end
  425.  
  426. Msg = Msg' '
  427. if rxfuncquery('RXSAY') = 0
  428.   then call rxSay AnsiPre
  429.   else Msg = AnsiPre||Msg
  430. do while Msg <> ''
  431.   Break = lastpos(' ', left(Msg, LLeng))
  432.   if Break > 0
  433.     then do
  434.       DispLine = left(Msg, Break-1)
  435.       Msg = substr(Msg, Break+1)
  436.     end
  437.     else do
  438.       DispLine = left(Msg, LLeng-1)
  439.       Msg = substr(Msg, LLeng)
  440.     end
  441.   if Msg = ''
  442.     then say DispLine||Msg.!EEol
  443.     else say DispLine
  444. end
  445. return 0
  446.  
  447. /*****************************************************************************
  448.  * MSGTUNE class                                                             *
  449.  *****************************************************************************/
  450. MsgTune: procedure expose (Globals)
  451. trace 'O'
  452. parse arg Class .
  453. select
  454.   when Msg.!Popup
  455.     then nop
  456.   when wordpos(Class, 'E F') > 0
  457.     then do I = 300 to 100 by -100
  458.       call beep I, (100 * (I<>100) + 500 * (I=100))
  459.       do 300; end
  460.     end
  461.   when Class = 'W'
  462.     then call beep 300, 200
  463.   otherwise nop
  464. end
  465. return 0
  466.  
  467. /*****************************************************************************
  468.  * INITMSGS                                                                  *
  469.  *****************************************************************************/
  470. InitMsgs: procedure expose (Globals)
  471. trace value 'O'
  472. Msg.9999 = 'M %1'
  473. Msg.!Ver = '1.00'
  474. MsgFileName = 'SRVINIT.MSG'
  475. parse source . . Me
  476. MyPath = left(Me, max(3, lastpos('\', Me)-1))
  477. call setlocal
  478. call value 'DPATH', MyPath';'value('DPATH',,'OS2ENVIRONMENT'), 'OS2ENVIRONMENT'
  479. MsgFile = stream(MsgFileName, 'C', 'QUERY EXISTS')
  480. if MsgFile = '' & \rxFuncQuery('RXSEARCHPATH')
  481.   then MsgFile = rxSearchPath('DPATH', MsgFileName)
  482. call endlocal
  483. if MsgFile = ''
  484.   then do
  485.     say 'Error:  Message file' MsgFile 'not found.'
  486.     return
  487.   end
  488. Msgs = strip(charin(MsgFile, 1, stream(MsgFile, 'C', 'QUERY SIZE')), 'T', '1A'x)
  489. call stream MsgFile, 'C', 'CLOSE'
  490. CrLf = '0D0A'x
  491. Lf = '0A'x
  492. do while Msgs <> ''
  493.   if \abbrev(Msgs, '*')
  494.     then parse var Msgs MsgN Msg.MsgN (CrLf) Msgs
  495.     else do
  496.       parse var Msgs Key KArg (CrLf) Msgs
  497.       select
  498.         when Key = '*CONT'
  499.           then Msg.MsgN = Msg.MsgN||Lf||KArg
  500.         when Key = '*VERSION'
  501.           then Msg.!Ver = KArg
  502.         otherwise nop
  503.       end
  504.     end
  505. end
  506. if symbol('MSG.!MIN') = 'VAR'
  507.   then if Msg.!Min > Msg.!Ver
  508.     then call Report '9999W', MsgFileName Msg.!Min 'desired; ' Msg.!Ver 'found.'
  509. return 0
  510.  
  511. /*****************************************************************************
  512.  * SHOWRETURN                                                                *
  513.  *****************************************************************************/
  514. ShowReturn: procedure expose (Globals)
  515. trace value 'O'
  516. Res = arg(1)
  517. Max = 400
  518. XChar = (verify(arg(1), xrange('20'x, '7F'x)) > 0)
  519. if XChar
  520.   then do
  521.     call Report 9997, translate(Res,, '0007090A0D'x, ' ')
  522.     Temp = c2x(Res)
  523.     if length(Temp) > Max
  524.       then Temp = left(Temp, Max-3)'...'
  525.     call Report '9999X', "= '"Temp"'x"
  526.   end
  527.   else call Report 9997, Res
  528. return Res
  529. /**::CLAM::end::**************************************************************/
  530.  
  531. /*****************************************************************************
  532.  *                              CSRVUP ROUTINES                              *
  533.  *****************************************************************************/
  534.  
  535. /*****************************************************************************
  536.  * CHECKENVIRONMENT                                                          *
  537.  * Retrieve environment information from the INI file, if available.         *
  538.  * Otherwise, checks out the environment variables.                          *
  539.  * Set Parms.!LinkCore to indicate if CORE needs to be linked or not.        *
  540.  * Switch to the run directory.                                              *
  541.  *****************************************************************************/
  542. CheckEnvironment: procedure expose (Globals)
  543. trace 'O';call Report 9996, 'CheckEnvironment'
  544. trace value TrVal
  545. call Report 3503                       /* checking env */
  546. File.!CoreIni = rxCouInfo('GET', 'INIFILE')
  547. UDr = rxCouInfo('GET', 'LOCAL')
  548. CDr = rxCouInfo('GET', 'REMOTE')
  549. UDr = CheckEnv2(UDr, 'Local')
  550. CDr = CheckEnv2(CDr, 'Remote')
  551. call Report 3504, CDr, UDr           /* Env var report */
  552. return ShowReturn(0)
  553.  
  554. /***** CheckEnv2 *************************************************************/
  555. CheckEnv2:
  556. trace 'O';call Report 9996, 'CheckEnvironment' arg(1)','arg(2)
  557. trace value TrVal
  558. parse arg EVal, EDesc
  559. if abbrev(EVal, 'ERROR:')
  560.   then do
  561.     Ctl.!EnvError = 1
  562.     parse var EVal ':' ErrCode
  563.     call Report 3505, ErrCode, EDesc
  564.     EVal = ''
  565.   end
  566.   else do
  567.     Test = CheckPath(EVal, 'DIR')
  568.     select
  569.       when Test = 'OK USED'
  570.         then if \DriveReadable(EVal)
  571.           then call Report 3509, EVal   /* unreadable */
  572.       when Test = 'OK FREE'
  573.         then call Report 3506, EVal     /* does not exist */
  574.       when Test = 'BAD'
  575.         then call Report 3507, EVal     /* bad spec */
  576.       otherwise
  577.         call Report 3508, Test, EVal    /* something odd */
  578.     end
  579.     EVal = Normalize(EVal, 'CORE')
  580.   end
  581. return ShowReturn(EVal)
  582.  
  583. /*****************************************************************************
  584.  * TRAPCMD OsCmd [,FailureString]                                            *
  585.  * Execute an OS/2 command and store the result in the log file.             *
  586.  *                                                                           *
  587.  * If any lines beginning with the failure string are returned by the        *
  588.  * command,  the command is assumed to have failed even if the rc is zero.   *
  589.  *****************************************************************************/
  590. TrapCmd: procedure expose (Globals)
  591. trace 'O';call Report 9996, 'TrapCmd' arg(1)','arg(2)','arg(3)
  592. trace value TrVal
  593. parse arg OsCmd
  594. FailStr.0 = arg() - 1
  595. do J = 1 to FailStr.0
  596.   FailStr.J = translate(arg(J+1))
  597. end J
  598. PreQueued = queued()
  599. call Report 3532, OsCmd                  /* Log command */
  600. '('OsCmd '2>&1) | RXQUEUE'
  601. RetC = rc
  602. do queued() - PreQueued
  603.   parse pull CmdRes
  604.   CmdRes = strip(CmdRes)
  605.   call Report 3533, CmdRes
  606.   CmdRes = translate(CmdRes)
  607.   do J = 1 to FailStr.0 while RetC = 0
  608.     if abbrev(translate(CmdRes), FailStr.J, 1) | wordpos(FailStr.J, CmdRes) > 0
  609.       then RetC = 99999
  610.   end
  611. end
  612. call Report 3533, 'RC('RetC')'
  613. return ShowReturn(RetC)
  614.  
  615. /*****************************************************************************
  616.  * TRAPCMD2 OsCmd                                                            *
  617.  * Execute an OS/2 command, log the results, and return them as one string.  *
  618.  *****************************************************************************/
  619. TrapCmd2: procedure expose (Globals)
  620. trace 'O';call Report 9996, 'TrapCmd2' arg(1)
  621. trace value TrVal
  622. parse arg OsCmd
  623. PreQueued = queued()
  624. call Report 3532, OsCmd                  /* Log command */
  625. '('OsCmd '2>&1) | RXQUEUE'
  626. RetC = rc
  627. Res = ''
  628. do queued() - PreQueued
  629.   parse pull CmdRes
  630.   CmdRes = strip(CmdRes)
  631.   call Report 3533, CmdRes
  632.   Res = Res CmdRes '0'x
  633. end
  634. call Report 3533, 'RC('RetC')'
  635. call ShowReturn ''
  636. return (Res)
  637.  
  638. /*****************************************************************************
  639.  * INITLOG                                                                   *
  640.  * Determine the new log file name to use, and call ClInitLog to initialize  *
  641.  * it.  Clean up the old log files.                                          *
  642.  *****************************************************************************/
  643. InitLog: procedure expose (Globals)
  644. trace 'O';call Report 9996, 'InitLog'
  645. trace value TrVal
  646. MaxLogs = 9
  647. NumLogs = 3
  648. LogBase = left(File.!Log, lastpos('.', File.!Log)-1)
  649.  
  650. do J = MaxLogs to NumLogs by -1
  651.   call rxDelete LogBase'.LG'J
  652. end
  653. do J = NumLogs-1 to 2 by -1
  654.   'RENAME' LogBase'.LG'J filespec('NAME', LogBase'.LG'J+1) '>NUL 2>&1'
  655. end
  656. if NumLogs > 1
  657.   then 'RENAME' File.!Log filespec('NAME', LogBase'.LG2') '>NUL 2>&1'
  658. call ClInitLog File.!Log 1
  659. call Report 3510, File.!Log         /* Display name of log */
  660. return ShowReturn(0)
  661.  
  662. /*****************************************************************************
  663.  * READINI                                                                   *
  664.  * Read stored parameters from CORE INI file.                                *
  665.  *****************************************************************************/
  666. ReadIni: procedure expose (GLobals)
  667. trace 'O';call Report 9996, 'ReadIni'
  668. trace value TrVal
  669. if abbrev(rxOs2Ini(File.!CoreIni, 'CSRVUP', '$RXALL', 'KEYS'), '$')
  670.   then do
  671.     if rxFileExist(File.!CoreIni)
  672.       then call Report 16, File.!CoreIni
  673.     return ShowReturn(1)
  674.   end
  675. Booleans = 'LogOff AutoFix LCSF'
  676. do I = 1 to Keys.0
  677.   Key = Keys.I
  678.   KVal = IniGet(File.!CoreIni, 'COREUP', Key)
  679.   if wordpos(Key, Booleans) > 0
  680.     then KVal = (KVal = 1)
  681.   call value "Parms.!"Key, KVal
  682. end
  683. return ShowReturn(0)
  684.  
  685. /*****************************************************************************
  686.  * PARSEPARMS                                                                *
  687.  * Parse the parameters.  Note that the first slash has been stripped before *
  688.  * we were called.                                                           *
  689.  *****************************************************************************/
  690. ParseParms: procedure expose (Globals) SlashParms
  691. trace 'O';call Report 9996, 'ParseParms' SlashParms
  692. trace value TrVal
  693. call Report 4                          /* Checking parameters */
  694. call Report 5, SlashParms              /* List parms */
  695. return ShowReturn(0)
  696.  
  697. /*****************************************************************************
  698.  * SAVEPARMS                                                                 *
  699.  *****************************************************************************/
  700. SaveParms: procedure expose (Globals)
  701. trace 'O';call Report 9996, 'SaveParms'
  702. trace value TrVal
  703. if Opt.!Save
  704.   then do
  705.     SaveList = 'CDomains UDomains ODomains CServers Uid AutoFix LogOff Access'
  706.     do while SaveList <> ''
  707.       parse var SaveList Save SaveList
  708.       Val = value('Opt.!'Save)
  709.       if Val = ''
  710.         then call rxOs2Ini File.!CoreIni, 'CSRVUP', Save, '$RXDEL'
  711.         else call rxOs2Ini File.!CoreIni, 'CSRVUP', Save, Val
  712.     end
  713.     if left(Opt.!PassWord, 1) = '*'
  714.       then do
  715.         Opt.!PassWord = substr(Opt.!Password, 2)
  716.         New = x2c(d2x(random(15))||c2x(Opt.!PassWord)||d2x(random(15)))
  717.         call rxOs2Ini File.!CoreIni, 'CSRVUP', '0Flags', New
  718.         do 2; call beep 2400, 100; do 500; end; end
  719.       end
  720.   end
  721. return
  722.  
  723. /*****************************************************************************
  724.  * REGEXTFUNCS                                                               *
  725.  *****************************************************************************/
  726. RegExtFuncs: procedure expose (Globals) RxUtilsMin
  727. trace 'O';call Report 9996, 'RegExtFuncs'
  728. trace value TrVal
  729. call Report 3524, 'RXUTILS'            /* Registering functions */
  730. call rxfuncadd 'RXLOADFUNCS', 'RXUTILS', 'RXLOADFUNCS'
  731. Syntax.Ref = 'REGEXTFUNCS'
  732. RxUtilsVer = rxLoadFuncs()
  733. drop Syntax.Ref
  734. if RxUtilsVer < RxUtilsMin
  735.   then call Report 3525, 'RXUTILS.DLL', RxUtilsMin, RxUtilsVer /* RXUTILS downlevel */
  736.  
  737. call Report 3524, 'COUENV'
  738. call rxfuncadd 'RXCOUINFO', 'COUENV', 'RXCOUINFO'
  739. Syntax.Ref = 'COUENV'
  740. call rxCouInfo 'VER'
  741. drop Syntax.Ref
  742.  
  743. if rxOs2Ver() >= 2.0
  744.   then do
  745.     call Report 3524, 'REXXUTIL'          /* Registering functions */
  746.     call RxFuncAdd 'SYSLOADFUNCS', 'REXXUTIL', 'SYSLOADFUNCS'
  747.     call SysLoadFuncs
  748.   end
  749. return ShowReturn(0)
  750.  
  751. /*****************************************************************************
  752.  * CHECKSEMFILE                                                              *
  753.  *****************************************************************************/
  754. CheckSemFile: procedure expose (Globals)
  755. trace 'O';call Report 9996, 'CheckSemFile'
  756. trace value TrVal
  757. if rxFileExist(File.!SemFile)
  758.   then call Report 'F', 3000, File.!SemFile       /* Exception found */
  759. return ShowReturn(0)
  760.  
  761. /*****************************************************************************
  762.  * INITIALIZE                                                                *
  763.  * Initialize everything and then some.                                      *
  764.  *****************************************************************************/
  765. Initialize: procedure expose (Globals) SlashParms RxUtilsMin PgmVer PgmDate
  766. trace 'O';call Report 9996, 'Initialize'
  767. trace value TrVal
  768.  
  769. call Report '3500I', 'CSRVUP' PgmVer '('PgmDate')', date(), time() /* Init */
  770.  
  771. Opt.!Home = directory()
  772. call RegExtFuncs
  773. Opt.!Product = rxCouInfo('VER')
  774. Opt.!BDr = rxBootDrive()
  775. Opt.!Os2Ver = rxOs2Ver()
  776. if rxAnsi() <> 'ON'
  777.   then 'ANSI ON'
  778.  
  779. /*
  780.  * Retrieve the drive values from the user's environment.
  781.  */
  782. call CheckEnvironment
  783.  
  784. /*
  785.  * Set constant file names.
  786.  */
  787. File.!PgmPath = left(File.!Me, LastPos('\', File.!Me)-1)
  788. /* test only:  May need to above exists */
  789. File.!Logs = strip(rxCouInfo('GET', 'SYSTEM'), 'T', '\')
  790. File.!SemFile = Opt.!BDr'\NOSTART.COU'         /* Semaphore file */
  791. /**** PTR 10041 start ****/
  792. ExecName = filespec('NAME', File.!Me)
  793. File.!Log = File.!Logs'\'overlay('LOG', ExecName, length(ExecName)-2)
  794. /**** PTR 10041 end ****/
  795. if length(File.!PgmPath) = 2
  796.   then File.!PgmDir = File.!PgmPath'\'
  797.   else File.!PgmDir = File.!PgmPath
  798. call directory File.!PgmDir
  799.  
  800. Opt.!StDr = word(rxDriveMap('C:', 'FREE'), 1)       /* free drive */
  801. call InitLog                           /* Initialize the log file */
  802. call CheckSemFile
  803.  
  804. call value 'PATH', File.!PgmDir';'value('PATH',,'OS2ENVIRONMENT'), 'OS2ENVIRONMENT'
  805. /*
  806. call value 'PATH', UDr'COREDATA;'value('PATH',,'OS2ENVIRONMENT'), 'OS2ENVIRONMENT'
  807. call value 'DPATH', value('DPATH',,'OS2ENVIRONMENT')UDr'COREDATA;', 'OS2ENVIRONMENT'
  808. */
  809. /*
  810. call ParseParms
  811. */
  812. /*
  813. call SaveParms
  814. */
  815. Opt.!Access = GetAccess()
  816.  
  817. do queued(); pull .; end
  818. call Report 3511                       /* Init complete */
  819. return ShowReturn(0)
  820.  
  821. /*****************************************************************************
  822.  * GETACCESS                                                                 *
  823.  *****************************************************************************/
  824. GetAccess: procedure expose (Globals)
  825. trace 'O';call Report 9996, 'GetAccess'
  826. trace value TrVal
  827. Opt.!Access = IniGet(File.!CoreIni, 'SystemData', 'AccessProvided')
  828. if Opt.!Access = ''
  829.    then Opt.!Access = IniGet(File.!CoreIni, 'COREUP', 'Access')
  830. return ShowReturn(Opt.!Access)
  831.  
  832. /*****************************************************************************
  833.  * QLOGGEDON                                                                 *
  834.  * Returns 1 if user appears to be logged on to the network, 0 o/w.          *
  835.  *****************************************************************************/
  836. QLoggedOn: procedure expose (Globals)
  837. trace 'O';call Report 9996, 'QLoggedOn'
  838. trace value TrVal
  839. parse value rxUserInfo() with User Wks Domain
  840. return (Domain <> '.' & User <> '.')
  841.  
  842. /*****************************************************************************
  843.  * STARTNETWORK                                                              *
  844.  * Access the network                                                        *
  845.  *****************************************************************************/
  846. StartNetwork: procedure expose (Globals)
  847. trace 'O';call Report 9996, 'StartNetwork'
  848. trace value TrVal
  849. do J = 1 to words(Opt.!Access)
  850.   AccMeth = word(Opt.!Access, J)
  851.   select
  852.     when AccMeth = 'NETBIOS'
  853.       then call StartNetwork.Netbios
  854.     when AccMeth = 'NFS'
  855.       then call StartNetwork.Nfs
  856.     otherwise
  857.       call Report 3515, AccMeth  /* Unknown method */
  858.   end
  859. end
  860. return ShowReturn(0)
  861.  
  862. /***** NFS *******************************************************************/
  863. StartNetwork.Nfs: procedure expose (Globals)
  864. trace 'O';call Report 9996, 'StartNetwork.Nfs'
  865. trace value TrVal
  866. EtcDir = value('ETC',,'OS2ENVIRONMENT')
  867. if EtcDir <> ''
  868.   then do
  869.     MTab = strip(EtcDir, 'T', '\')'\MTAB'
  870.     if rxFileExist(MTab)
  871.       then call rxDelete MTab
  872.   end
  873. return ShowReturn(0)
  874.  
  875. /***** NETBIOS ***************************************************************/
  876. StartNetwork.Netbios: procedure expose (Globals)
  877. trace 'O';call Report 9996, 'StartNetwork.Netbios'
  878. trace value TrVal
  879. call Report '3514', 'NETBIOS'        /* Checking network */
  880. parse value rxUserInfo() with Opt.!LUser Opt.!LMachine Opt.!LDomain
  881. if QLoggedOn()
  882.   then call Report 3517, Opt.!LUser, Opt.!LMachine, Opt.!LDomain   /* Logged on */
  883.   else call Report 3518                 /* Not logged on */
  884.  
  885. Services = TrapCmd2('NET START')
  886.  
  887. if wordpos('REQUESTER', Services) = 0
  888.   then if TrapCmd('NET START REQUESTER', 'The requester service could not be',
  889.       'started.', 'The service name is not valid.') <> 0
  890.     then call Report '3516F', 'requester', File.!Log  /* Req not started */
  891.  
  892. /**
  893. SysFile = rxSearchPath('DPATH', 'SYSLEVEL.SRV')
  894. if SysFile <> ''
  895.   then TryReset = (substr(rxSysLevel(SysFile, 'LEVEL'), 3) < 6000)
  896.   else TryReset = (Opt.!Os2Ver < 2.0)
  897. TryReset = TryReset & QLoggedOn()
  898. **/
  899. TryReset = 0  /* test only */
  900. Sleep = 30
  901. ISleep = 5
  902. ILoop = 3
  903. ISleep = 0  /* test only */
  904. ILoop = 1  /* test only */
  905. Service = 'SERVER'
  906. ChkMsg = 'The server service could not be started.'
  907. SRc = \(wordpos('SERVER', Services) > 0)
  908. do while SRc <> 0
  909.   do ILoop until SRc = 0
  910.     SRc = StartServer(Service, ChkMsg)
  911.     if SRc <> 0
  912.       then call rxSleep ISleep
  913.   end
  914.   if SRc <> 0
  915.     then if TryReset
  916.       then do
  917.         call Report 3520    /* Attempting resynch */
  918.         DomServer = rxDCName(Opts.!LDomain)
  919.         if \abbrev(DomServer, '\\')
  920.           then call Report 3521, DomServer
  921.           else do
  922.             call TrapCmd 'NET ADMIN' DomServer '/C NET USER' Opts.!LMachine 'ZORKMIDS'
  923.             call TrapCmd 'NET ACCOUNTS /ROLE:STANDALONE'
  924.             call TrapCmd 'NET USER' Opts.!LMachine 'ZORKMIDS'
  925.             call TrapCmd 'NET ACCOUNTS /ROLE:MEMBER'
  926.             TryReset = 0
  927.           end
  928.       end
  929.       else do
  930.         call Report '3516W', 'server', File.!Log
  931.         call Report 3522, Sleep
  932.         call rxSleep Sleep
  933.         Sleep = min(Sleep + 30, 900)  /* Max 15 minutes */
  934.       end
  935.   Service = 'NETLOGON'
  936.   ChkMsg = 'could not be started'
  937. end
  938. parse value rxUserInfo() with Opt.!LUser Opt.!LMachine Opt.!LDomain
  939. Opt.!Domain = (abbrev(rxDCName(Opt.!LMachine), '\\'))
  940. if QLoggedOn()
  941.   then do
  942.     call Report 3519       /* Sharing QNET mon alias */
  943.     call TrapCmd 'NET SHARE QNETMON='Opt.!BDr'\ /REMARK:"QNET monitoring alias"'
  944. /**** PTR 238 start ****/
  945.     call Report 3534      /* Dynamic aliases and access profiles */
  946.     call rxOS2Ini File.!CoreIni, 'DynamicAliases', '$RXALL', 'ALIAS.'
  947.     do I = 1 to Alias.0
  948.       ShareCmd = IniGet(File.!CoreIni, 'DynamicAliases', Alias.I)
  949.       if ShareCmd <> ''
  950.         then call TrapCmd 'NET SHARE' Alias.I'='ShareCmd
  951.     end
  952.     call rxOS2Ini File.!CoreIni, 'DynamicACPs', '$RXALL', 'ACP.'
  953.     do I = 1 to ACP.0
  954.       List = IniGet(File.!CoreIni, 'DynamicACPs', ACP.I)
  955.       do while List <> ''
  956.         parse var List Who '=' Rights ';' List
  957.         call DefineACP ACP.I, Who, Rights
  958.       end
  959.     end
  960. /**** PTR 238 end ****/
  961.   end
  962. return ShowReturn(0)
  963.  
  964. StartServer:
  965. parse arg Service, ChkMsg
  966. XC = TrapCmd('NET START' Service, ChkMsg, 'The service name is not valid.')
  967. if XC <> 0
  968.   then do
  969.     SrvOk = 0
  970.     PreQ = queued()
  971.     'NET START /N | RXQUEUE /FIFO'
  972.     do while queued() > PreQ & \SrvOk
  973.       pull Line
  974.       SrvOk = (wordpos('SERVER', Line) > 0)
  975.     end
  976.     if SrvOk
  977.       then XC = 0
  978.     do while queued() > PreQ; pull .; end
  979.   end
  980. return XC
  981.  
  982. /**** PTR 238 start ****/
  983. DefineACP: procedure expose (Globals)
  984. parse arg PhysPath, Names, Rights
  985. if PhysPath = '' | Names = '' | Rights = ''
  986.   then return 1
  987.  
  988. XC = 0
  989. do J = 1 to words(Names)
  990.   Name = word(Names, J)
  991.   if TrapCmd('NET ACCESS' PhysPath '/ADD' Name':'Rights, 'NET2225') <> 0
  992.     then if TrapCmd('NET ACCESS' PhysPath '/GRANT' Name':'Rights, 'NET3739') <> 0
  993.       then XC = XC + TrapCmd('NET ACCESS' PhysPath '/CHANGE' Name':'Rights)
  994. end
  995. return XC
  996. /**** PTR 238 end ****/
  997.  
  998. /****************************************************************************
  999.  * GETAUXALIASES                                                            *
  1000.  * Access auxilliary aliases                                                *
  1001.  ****************************************************************************/
  1002. GetAuxAliases: procedure expose (Globals)
  1003. trace 'O';call Report 9996, 'GetAuxAliases'
  1004. trace value TrVal
  1005. /**
  1006. Other = Opt.!StDr 'CORESTUF'
  1007. MaxTry = 1
  1008. do while Other <> ''
  1009.   parse var Other Dr Alias Other
  1010.   call Report 38, Alias, Dr
  1011.   do MaxTry until Ok
  1012.     call TrapCmd 'NET USE' Dr Alias
  1013.     Ok = rxDirExist(Dr'\')
  1014.     if \Ok
  1015.       then call rxSleep 10
  1016.   end
  1017.   if \Ok
  1018.     then call Report '40W', Alias
  1019. end
  1020. **/
  1021. return ShowReturn(0)
  1022.  
  1023. /*****************************************************************************
  1024.  * UPDATELOCAL                                                               *
  1025.  *****************************************************************************/
  1026. UpdateLocal: procedure expose (Globals)
  1027. trace 'O';call Report 9996, 'UpdateLocal'
  1028. trace value TrVal
  1029. call Report 3007   /* Updating local files */
  1030. call TrapCmd 'REPLACE' CDr'NAMEFIND.CMD' Opt.!StDr'\' '/U'
  1031. call TrapCmd 'REPLACE' CDr'NAMEFIND.CMD' Opt.!StDr'\' '/A'
  1032. call TrapCmd 'REPLACE' CDr'COREUTIL\CSRVUP\QCOREID.CMD' Opt.!StDr'\' '/U'
  1033. call TrapCmd 'REPLACE' CDr'COREUTIL\CSRVUP\QCOREID.CMD' Opt.!StDr'\' '/A'
  1034. return 0
  1035.  
  1036. /****************************************************************************
  1037.  * STARTPROGRAMS                                                            *
  1038.  ****************************************************************************/
  1039. StartPrograms: procedure expose (Globals)
  1040. trace 'O';call Report 9996, 'StartPrograms'
  1041. trace value TrVal
  1042. call Report 3523, 'TIMEXEC'
  1043. call directory Opt.!Home
  1044. call TrapCmd '(START "TimeExec" /C /FS TIMEXEC.EXE >CON 2>&1)'
  1045. return ShowReturn(0)
  1046.  
  1047. /****************************************************************************
  1048.  * LASTTASKS                                                                *
  1049.  ****************************************************************************/
  1050. LastTasks: procedure expose (Globals)
  1051. trace 'O';call Report 9996, 'LastTasks'
  1052. trace value TrVal
  1053. /*
  1054. call TrapCmd CDr'SWITCHTO /SSTARTUP'
  1055. */
  1056. /*
  1057. parse value rxSearchPath('PATH','NET.EXE') with File.!LanDrive 3
  1058. if File.!LanDrive <> ''
  1059.   then call rxDelete File.!LanDrive'IBMLAN\LOGS\MESSAGES.LOG'  /* Erase msg log */
  1060. */
  1061. return ShowReturn(0)
  1062.  
  1063. /*****************************************************************************
  1064.  * CLEANUP                                                                   *
  1065.  * Clean up after ourselves and exit.                                        *
  1066.  *****************************************************************************/
  1067. CleanUp:
  1068. parse arg RetC
  1069. /**
  1070. if symbol('Opt.!DROPDISKS') = 'VAR'
  1071.   then do I = 1 to words(Opt.!DropDisks)
  1072.     call TrapCmd 'NET USE' word(Opt.!DropDisks, I) '/D /Y'
  1073.   end
  1074. **/
  1075. call Report 3531, RetC    /* Prpgram complete */
  1076. signal off novalue
  1077. exit RetC
  1078.  
  1079. /*****************************************************************************
  1080.  * TELL                                                                      *
  1081.  *****************************************************************************/
  1082. Tell:
  1083. say
  1084. say 'SRVINIT' PgmVer '('PgmDate') -- Server Initialization'
  1085. say
  1086. say 'Syntax:  SRVINIT [parameters]'
  1087. say
  1088. say '  /DEBUG                            - Force additional status messages'
  1089. say '  /DEBUG <debugfile>                - Trace execution to file'
  1090. say
  1091. exit 0
  1092.  
  1093. /*****************************************************************************
  1094.  *                       DEBUGGING and ERROR RECOVERY                        *
  1095.  *****************************************************************************/
  1096. Debug:
  1097. parse var Args ArgA '/DEBUG' DArg '/' ArgB
  1098. Args = strip(ArgA '/'ArgB, 'T', '/')
  1099. if DArg = ''
  1100.   then do
  1101.     call Report '9999W', 'Debug mode activated.'
  1102.     call SetMsgClass 'X', 'X'
  1103.     return
  1104.   end
  1105.  
  1106. parse source . . Me
  1107. if DArg = '*'
  1108.   then DArg = left(value('COMSPEC',,'OS2ENVIRONMENT'), 2)'\CSRVUP.TRA'
  1109. Prompt.1 = 'Debug trace requested.  Trace will be placed in' DArg'.'
  1110. Prompt.2 = 'Press N and Enter to abort, or Enter to continue.'
  1111. Prompt.0 = 2
  1112. if PromptUser('', 'WORD', 'YES NO', 1, 1) = 'NO'
  1113.   then exit 250
  1114. call setlocal
  1115. call value 'CORETRACE','I','OS2ENVIRONMENT'
  1116. interpret "'CALL" Me Args "/DEBUG 2>"DArg"'"
  1117. exit rc
  1118.  
  1119. BugInit:
  1120. if symbol('GLOBALS') = 'LIT'
  1121.   then do
  1122.     Globals = 'Msg. TrVal'
  1123.     TrVal = 'O'
  1124.   end
  1125. return
  1126.  
  1127. Halt:
  1128. Where = SigL
  1129. call off halt
  1130. if abbrev(stream('STDIN:', 'C', 'CLOSE'), 'READY')
  1131.   then do
  1132.     call beep 500, 100;  call beep 750, 100
  1133.     say
  1134.     say 'Halt detected.  Do you want to abort SRVINIT?'
  1135.     pull Resp .
  1136.     Resp = left(Resp, 1)
  1137.   end
  1138.   else do
  1139.     Resp = 'N'
  1140.     call Report 3528  /* can't close stdin - Unconditional abort */
  1141.   end
  1142. if Resp = 'N'
  1143.   then call on halt
  1144.   else do
  1145.     call value 'CORETRACE','','OS2ENVIRONMENT'
  1146.     call Report 3529, Where  /* exec halted */
  1147.     call Report 3530         /* attempt cleanup */
  1148.     call CleanUp 255
  1149.   end
  1150. return
  1151.  
  1152. Syntax:
  1153. signal off error; signal off failure; signal off halt
  1154. signal off novalue; signal off notready; signal off syntax
  1155. if arg(1) = '<WHERE>'
  1156.   then Where = arg(2)
  1157.   else Where = SigL
  1158. call BugInit
  1159. select
  1160.   when Syntax.Ref = 'REGEXTFUNCS'
  1161.     then call Report 3526, 'RXUTILS.DLL', RxUtilsMin     /* not found */
  1162.   when Syntax.Ref = 'COUENV'
  1163.     then call Report 3527, 'COUENV.DLL'   /* not found */
  1164.   otherwise do
  1165.     call Report '9999E', '>> Syntax error' rc '('errortext(rc)') raised in line' Where
  1166.     if rc = 43                             /* Routine not found */
  1167.       then do
  1168.         Quotes = '"'||"'"
  1169.         SL = sourceline(Where)
  1170.         if pos(left(strip(SL), 1), Quotes) <> 0
  1171.           then do
  1172.             Temp = translate(sourceline(Where),,Quotes)
  1173.             parse upper var Temp 'CALL' Rtn .
  1174.             if Rtn = ''
  1175.               then Rtn = word(Temp, 1)
  1176.             call Report '9999W', '>>' Rtn '=' value(Rtn)
  1177.           end
  1178.       end
  1179.   end
  1180. end
  1181. signal DebugExit
  1182.  
  1183. Novalue:
  1184. signal off error; signal off failure; signal off halt
  1185. signal off novalue; signal off notready; signal off syntax
  1186. Where = SigL
  1187. call BugInit
  1188. call Report '9999E', '>> Novalue error raised in line' Where
  1189. call Report '9999W', '>> Undefined variable was:' condition('D')
  1190. signal DebugExit
  1191.  
  1192. DebugExit:
  1193. parse upper arg SkipQues .
  1194. signal on syntax name ExitCont
  1195. if symbol('DLG') = 'VAR'
  1196.   then call dBoxDestroy Dlg
  1197. ExitCont:
  1198. signal off syntax
  1199. if SkipQues <> '<SKIP>'
  1200.   then do
  1201.     call Report '9999W', 'Line reads: "'sourceline(Where)'"'
  1202.     if symbol('MSG.!NORM') = 'VAR'
  1203.       then say Msg.!Norm
  1204.       else say ''
  1205.     say 'Please record the above error numbers and messages.  Press <Enter> to exit.'
  1206.     if translate(linein('STDIN:')) <> '/D'
  1207.       then exit 255
  1208.   end
  1209. trace ?i
  1210. nop
  1211. exit
  1212.