home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
netdor3.zip
/
DISK_12
/
IMAGE11.ZIP
/
ADMTOOLS
/
USER.CMD
< prev
next >
Wrap
OS/2 REXX Batch file
|
1993-09-27
|
21KB
|
601 lines
/*****************************************************************************
* USER - Control Users on Multiple Domains *
* M. Stokes, T. Bridgman (CORE at WATSON) *
*****************************************************************************
* Licensed Materials-Property of IBM *
* 5604-472 (c) Copyright IBM Corporation, 1993 *
* All rights reserved. *
* US Government Users Restricted Rights - *
* Use, duplication or disclosure restricted *
* by GSA ADP Schedule Contract with IBM Corp. *
*****************************************************************************
* Change History *
* version 1.0 - 8 May 90 - mstokes *
* version 1.1 - 8 Sep 91 - teb *
* - Add command line argument capability. *
* - Add support for either DC or domain name. *
* - No hidden password entry. *
* - Add /X (/NOVERIFY) and /DELETE options *
* - Add /GROUPS option to specify user's groups *
* - Add /ADMIN option to add user as an Administrator *
* - Rename to USER, incorporate DELUSER *
* 23 Oct 91 - teb *
* - error checking for result of operation *
* 24 Oct 91 - teb *
* - Added delay so RXDCNAME doesn't get confused. *
* 6 Nov 91 - teb *
* - User not added to groups when more than 1 domain specified. *
* 23 Jan 91 - teb *
* - Add admin user to ADMIN group. *
* 17 Aug 92 - teb *
* - Respect new RXUTILS error conventions. *
* 20 Aug 92 - teb *
* - Add unique return codes for exit conditions. *
* - Add /D:ALL *
* 18 Jan 93 - teb *
* - Add /QUERY option to query userid existence. *
* - New fix for wrong info returned by RXDCNAME. *
* 24 May 93 - teb *
* - No default group if running under product. *
*****************************************************************************/
trace 'O'
'@ECHO OFF'
call on halt /* Enable error traps */
signal on novalue
signal on syntax
parse arg Args
Args=strip(Args) /* PTR 266 */
if abbrev(Args, '?') | Args = ''
then signal Tell
Globals = 'Parms. Opts. Required'
call Initialize
call ParseArgs
call GetInfo
call FindDomains
call Execute
exit 0
/*****************************************************************************
* INITIALIZE *
*****************************************************************************/
Initialize: procedure expose (Globals)
say
say 'USER - version 1.2'
call LoadRxUtils
if rxOs2Ver() < 1.2
then call ErrExit 'OS/2 version 1.2 or later required.'
call setlocal
parse source . . Me
MyPath = left(Me, max(lastpos('\', Me)-1, 3))
call value 'PATH', MyPath';'value('PATH',,'OS2ENVIRONMENT'), 'OS2ENVIRONMENT'
return 0
/*****************************************************************************
* PARSEARGS *
*****************************************************************************/
ParseArgs: procedure expose (Globals) Args
parse value '' with Parms.!Desc Parms.!Uid Parms.!PWord Parms.!DomList
parse value 0 with Opts.!NoConfirm 1 Opts.!Delete 1 Opts.!Admin
if QProduct()
then Parms.!Groups = ''
else Parms.!Groups = 'CORE'
ValidOpts = 'ADD DEL PW'
parse var Args Parms.!Opt Args '/' SlashArgs
Parms.!Opt = strip(translate(Parms.!Opt)) /* Strip added due to PTR 266 */
select
when Parms.!Opt = 'ADD'
then do
parse upper var Args Parms.!Uid Parms.!PWord .
Parms.!Desc = subword(Args, 3)
Required = 'UID PWORD DESC DOMLIST'
end
when Parms.!Opt = 'DEL'
then do
parse upper var Args Parms.!Uid .
Required = 'UID DOMLIST'
end
when Parms.!Opt = 'PW'
then do
parse upper var Args Parms.!Uid Parms.!PWord .
Required = 'UID PWORD DOMLIST'
end
when Parms.!Opt = 'LOCK' | Parms.!Opt = 'UNLOCK'
then do
parse upper var Args Parms.!Uid .
Required = 'UID DOMLIST'
end
when Parms.!Opt = 'QUERY'
then do
parse upper var Args Parms.!Uid .
Required = 'UID DOMLIST'
end
otherwise call ErrExit 'Invalid option' Parms.!Opt '- USER ? for help.', 3
end
do while SlashArgs <> ''
parse var SlashArgs SArg '/' SlashArgs
parse upper var SArg SArg . ':' SOpt
select
when abbrev('DOMAINS', SArg)
then Parms.!DomList = SOpt
when SArg = 'X' | abbrev('NOVERIFY', SArg)
then Opts.!NoConfirm = 1
when abbrev('GROUPS', SArg)
then Parms.!Groups = SOpt
when abbrev('DELETE', SArg, 3)
then Opts.!Delete = 1
when SArg = 'ADMIN'
then Opts.!Admin = 1
otherwise call ErrExit 'Unrecognized option' SArg'.', 3
end
end
if \QProduct() & Opts.!Admin & wordpos(Parms.!Groups, 'ADMIN') = 0 &,
Parms.!Groups <> ''
then Parms.!Groups = Parms.!Groups 'ADMIN'
return 0
/*****************************************************************************
* GETINFO *
*****************************************************************************/
GetInfo: procedure expose (Globals)
if wordpos('UID', Required) > 0
then do while Parms.!Uid = ''
say
call rxSay 'Enter user id: '
parse upper linein Parms.!Uid .
end
if wordpos('DESC', Required) > 0
then do while Parms.!Desc = ''
say
call rxSay 'Enter user description (name and location): '
parse linein Parms.!Desc
end
if Opts.!Admin
then Parms.!Desc = Parms.!Desc '- Admin'
if wordpos('PWORD', Required) > 0
then do
do while Parms.!PWord = ''
say
call rxSay 'Enter password: '
parse upper linein Parms.!PWord
end
if length(Parms.!PWord) > 14
then call ErrExit 'Password must be 14 characters or less.', 7
end
if wordpos('DOMLIST', Required) > 0
then do while Parms.!DomList = ''
say
call rxSay 'Enter domain list or domain group: '
parse upper linein Parms.!DomList
end
return 0
/*****************************************************************************
* FINDDOMAINS *
*****************************************************************************/
FindDomains: procedure expose (Globals)
NewList = ''
Sep = d2c(26)
CDr = value('CORE.DIR',,'OS2ENVIRONMENT')
ServFile = CDr'LOCAL\COMPLEX\SERVERS.COR'
if Parms.!DomList = 'ALL'
then do
Parms.!DomList = ''
Temp = NameFind(ServFile ':TYPE DOMAIN :NICK /RETURN *')
if abbrev(Temp, '$RXERROR') | abbrev(Temp, 'ERROR:')
then Temp = ''
do while Temp <> ''
parse var Temp ':NICK.' Dom (Sep) Temp
Parms.!DomList = Parms.!DomList Dom
end
end
Retries = 3
do J = 1 until Parms.!DomList = ''
parse var Parms.!DomList Domain Parms.!DomList
DCName = rxDCName(Domain)
if abbrev(DCName, '$RXERROR') | abbrev(DCName, 'ERROR:')
then do
Servers = NameFind(ServFile ':GROUP' Domain ':NICK /RETURN *')
if abbrev(Servers, 'ERROR:') | Servers = ''
then DCName = ''
else do
do while Servers <> ''
parse var Servers ':NICK.' Server (Sep) Servers
Parms.!DomList = Server Parms.!DomList
end
iterate J
end
end
if DCName = ''
then do J = 1 to Retries until DCName <> ''
DCName = rxDCName(Domain)
if abbrev(DCName, '$RXERROR') | abbrev(DCName, 'ERROR:')
then DCName = ''
end
if DCName <> ''
then NewList = NewList DCName
else say d2c(7)'Warning: could not identify' Domain '- skipping.'
end
Parms.!DomList = strip(NewList)
if Parms.!DomList = ''
then call ErrExit 'Could not identify any domain names.', 4
return 0
/*****************************************************************************
* CONFIRM *
*****************************************************************************/
Confirm: procedure expose (Globals) Prompt.
say
do I = 1 to Prompt.0
say Prompt.I
end
if \Opts.!NoConfirm
then do
do until wordpos(Resp, 'Y N') > 0
say
call rxSay Prompt.!Question' '
Resp = translate(rxGetKey('ECHO'))
say
end
if Resp = 'N'
then call ErrExit 'Cancelled at user request.', 5
end
return 0
/*****************************************************************************
* EXECUTE *
*****************************************************************************/
Execute: procedure expose (Globals)
Prompt.0 = 0
select
when Parms.!Opt = 'ADD'
then do
call rxStemInsert 'PROMPT.', Prompt.0+1, 'Id: ' Parms.!Uid
call rxStemInsert 'PROMPT.', Prompt.0+1, 'User: ' Parms.!Desc
call rxStemInsert 'PROMPT.', Prompt.0+1, 'Password: ' Parms.!PWord
call rxStemInsert 'PROMPT.', Prompt.0+1, 'Domains: ' Parms.!DomList
call rxStemInsert 'PROMPT.', Prompt.0+1, 'Groups: ' Parms.!Groups
call rxStemInsert 'PROMPT.', Prompt.0+1, 'Del First:' Opts.!Delete
Prompt.!Question = 'Add this user (Y/N)?'
call Confirm
call AddUser
end
when Parms.!Opt = 'DEL'
then do
call rxStemInsert 'PROMPT.', Prompt.0+1, 'Id: ' Parms.!Uid
call rxStemInsert 'PROMPT.', Prompt.0+1, 'Domains: ' Parms.!DomList
Prompt.!Question = 'Delete this user (Y/N)?'
call Confirm
call DelUser
end
when Parms.!Opt = 'PW'
then do
call rxStemInsert 'PROMPT.', Prompt.0+1, 'Id: ' Parms.!Uid
call rxStemInsert 'PROMPT.', Prompt.0+1, 'Password: ' Parms.!PWord
call rxStemInsert 'PROMPT.', Prompt.0+1, 'Domains: ' Parms.!DomList
Prompt.!Question = 'Change this user''s password (Y/N)?'
call Confirm
call ChangePW
end
when Parms.!Opt = 'LOCK' | Parms.!Opt = 'UNLOCK'
then do
call rxStemInsert 'PROMPT.', Prompt.0+1, 'Id: ' Parms.!Uid
call rxStemInsert 'PROMPT.', Prompt.0+1, 'Domains: ' Parms.!DomList
Prompt.!Question = Parms.!Opt 'this user (Y/N)?'
call Confirm
call UserAccess(Parms.!Opt)
end
when Parms.!Opt = 'QUERY'
then call Query
end
return
/*****************************************************************************
* ADDUSER *
*****************************************************************************/
AddUser: procedure expose (Globals)
if Opts.!Delete
then call DelUser
do until Parms.!DomList = ''
parse var Parms.!DomList Domain Parms.!DomList
say
say 'Adding' Parms.!Uid 'to' Domain'...'
if Opts.!Admin
then Priv = 'ADMIN'
else Priv = 'USER'
'NET ADMIN' Domain '/C NET USER' Parms.!Uid Parms.!PWord '/ADD',
'/ACTIVE:YES /PRIVILEGE:'Priv '/PASSWORDREQ:YES',
'/USERCOMMENT:\"'Parms.!Desc'\" /FULLNAME:\"'Parms.!Desc'\"'
if rc <> 0
then do
call ErrExit 'Error' rc 'adding user to' Domain'.', 6
iterate
end
do I = 1 to words(Parms.!Groups)
Group = word(Parms.!Groups, I)
say 'Adding' Parms.!Uid 'to' Group 'group...'
'NET ADMIN' Domain '/C NET GROUP' Group Parms.!Uid '/ADD'
end
end
return
/*****************************************************************************
* QUERY *
*****************************************************************************/
Query: procedure expose (Globals)
say 'Querying presence of' Parms.!Uid'...'
do until Parms.!DomList = ''
parse var Parms.!DomList Domain Parms.!DomList
PreQ = queued()
'NET ADMIN' Domain '/C NET USER' Parms.!Uid '2>&1 | RXQUEUE /LIFO'
Exist = 0
parse value '' with Name Cmt Priv PWSet LLogon
do while queued() > PreQ
parse pull Line
ULine = translate(space(Line))
select
when ULine = 'USER ID' Parms.!Uid
then Exist = 1
when abbrev(ULine, 'USER''S COMMENT')
then Cmt = subword(Line, 3)
when abbrev(ULine, 'FULL NAME')
then Name = subword(Line, 3)
when abbrev(ULine, 'PRIVILEGE LEVEL')
then Priv = subword(Line, 3)
when abbrev(ULine, 'PASSWORD LAST SET')
then PWSet = subword(Line, 4)
when abbrev(ULine, 'LAST LOGON')
then LLogon = subword(Line, 3)
otherwise nop
end
end
call rxSay left(substr(Domain, 3), 12, '.')' '
if Exist
then do
if Name <> ''
then Info = Name
else Info = Cmt
if Cmt <> '' & Info <> Cmt
then Info = Info '('Cmt')'
if Info = ''
then Info = '(No user info)'
Info = strip(Info ' Priv:' Priv)
say Info
say copies(' ', 12) 'Last logon:' LLogon ' PW set:' PWSet
end
else say Parms.!Uid 'does not exist.'
end
return 0
/*****************************************************************************
* CHANGEPW *
*****************************************************************************/
ChangePW: procedure expose (Globals)
say 'Setting password for' Parms.!Uid'...'
call 'MULTCMD' 'NET USER' Parms.!Uid Parms.!Pword, Parms.!DomList
return
/*****************************************************************************
* DELUSER *
*****************************************************************************/
DelUser: procedure expose (Globals)
say 'Deleting' Parms.!Uid'...'
call 'MULTCMD' 'NET USER' Parms.!Uid '/D', Parms.!DomList
return
/*****************************************************************************
* USERACCESS *
*****************************************************************************/
UserAccess: procedure expose (Globals)
parse arg Op .
if Op = 'LOCK'
then Arg = 'NO'
else Arg = 'YES'
say Op'ing' Parms.!Uid'...'
call 'MULTCMD' 'NET USER' Parms.!Uid '/ACTIVE:'Arg, Parms.!DomList
return
/*****************************************************************************
* ERREXIT *
*****************************************************************************/
ErrExit:
parse arg EMsg, XCode
if XCode = '' then XCode = 2
say d2c(7)EMsg
exit XCode
/*****************************************************************************
* LOADRXUTILS *
*****************************************************************************/
LoadRxUtils: procedure
if \rxfuncadd('RXLOADFUNCS', 'RXUTILS', 'RXLOADFUNCS')
then do
signal on syntax name LoadRxUtils2
call rxLoadFuncs 'QUIET'
end
return 0
LoadRxUtils2:
signal off syntax /* Turn off temp error trap */
/* If you have an error trap in the program, use the following line instead
signal on syntax name syntax
*/
select
when rc = 40
then call rxLoadFuncs
when rc = 43
then do
say 'Error: RXUTILS.DLL not found.'
exit 2
end
otherwise do
say 'Error: Error' rc 'registering RXUTILS functions.'
exit 2
end
end
return 0
QProduct: procedure
call rxfuncadd 'RXCOUINFO', 'COUENV', 'RXCOUINFO'
signal on syntax name QProduct2
return (rxCouInfo('VER'))
QProduct2:
return 1 /* Assume most restrictive (product) if we can't tell */
/*****************************************************************************
* DEBUGGING and ERROR RECOVERY *
*****************************************************************************/
SignalOff:
signal off error
signal off failure
signal off halt
signal off novalue
signal off notready
signal off syntax
return
BugInit:
if symbol('GLOBALS') = 'LIT'
then do
Globals = 'TrVal'
TrVal = 'O'
end
return
Halt:
Where = SigL
call off halt
if abbrev(stream('STDIN:', 'C', 'CLOSE'), 'READY')
then do
call beep 100, 250
call rxSay 'Do you want to abort (Y/N)? '
do until pos(Ch, 'YND') <> 0
Ch = translate(rxGetKey('NOECHO'))
end
call rxSay Ch
end
else do
Ch = 'N'
say 'Could not close stdin. Unconditional abort.'
end
if Ch = 'N'
then call on halt
else if Ch = 'D'
then signal DebugHook
else exit 255
return 0
Failure:
Where = SigL
call SignalOff
call BugInit
say '>> Failure raised in line' Where
signal DebugExit
Error:
Where = SigL
call SignalOff
call BugInit
say '>> Error raised in line' Where
signal DebugExit
Syntax:
Where = SigL
call SignalOff
call BugInit
say '>> Syntax error' rc '('errortext(rc)') raised in line' Where
signal DebugExit
Novalue:
Where = SigL
call SignalOff
call BugInit
say '>> Novalue error raised in line' Where
say '>> Undefined variable was:' condition('D')
signal DebugExit
DebugExit:
parse upper arg SkipQues .
parse source . . Me
if SkipQues <> '<SKIP>'
then do
say 'Line reads: "'sourceline(Where)'"'
say 'Active file was:' Me
if symbol('ANSI.!Normal') = 'VAR'
then say ANSI.!Normal
else say
say 'Please notify the CORE Developers! Press <Enter> to exit.'
if translate(linein('STDIN:')) <> '/D'
then exit
end
DebugHook:
trace ?i
nop
exit
/*****************************************************************************
* TELL *
*****************************************************************************/
Tell:
if Args = '?' | Args = '' then do
call rxCls
say
say 'USER - Network User Control over Multiple Domains'
say
say 'Adding a userid:'
say 'USER ADD [userid [password [comment]]] [/Domains:domlist] [options]'
say
say ' userid - network userid to add'
say ' password - password for the userid'
say ' comment - user description (e.g., name and location)'
say ' domlist - list of domains (separated by spaces) or ALL'
say ' "options" may be any combination of:'
say ' /DELete - Force deletion of userid before adding it.'
say ' /Groups:grplist - Add user to specified groups.'
say ' /ADMIN - Add user with Admin privileges'
say ' /X - Quick execution (no confirmation prompt).'
say
say 'Deleting a userid:'
say 'USER DEL [userid [/Domains:domlist]]'
say
say 'Changing a password for a userid:'
say 'USER PW [userid [password]] [/Domains:domlist]'
say
call rxPause '[more]'
call rxCls
say
say
say 'USER - Network User Control over Multiple Domains'
say
say 'Locking or unlocking a user:'
say 'USER LOCK|UNLOCK [userid] [/Domains:domlist]'
say
say 'Query existence of a user:'
say 'USER QUERY [userid] [/Domains:domlist]'
say
say 'Enter USER ?? for return codes.'
end
if Args = '??' then do
call rxCls
say
say
say 'USER Return Codes'
say
say ' 0: Success'
say ' 2: Miscellaneous error (none of the following)'
say ' 3: Invalid option entered'
say ' 4: No domains could be identified'
say ' 5: User cancelled operation'
say ' 6: Execution error performing operation'
say ' 7: Password too long.'
say ' 255: Program error (syntax, novalue, etc.)'
end
say
exit 0