johnblood/tldm-universe
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
main
tldm-universe/Ardent/UV/APP.PROGS/PACT

2073 lines
62 KiB
Plaintext
Raw Permalink Normal View History

first push of universe files
2024-09-09 21:51:08 +00:00
*******************************************************************************
*
* Server subroutine for PICK Account Conversion Toolkit
*
* Module %M% Version %I% Date %H%
*
* (c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
* This is unpublished proprietary source code of Ardent Software Inc.
* The copyright notice above does not evidence any actual or intended
* publication of such source code.
*
*******************************************************************************
*
* Maintenence log - insert most recent change descriptions at top
*
* Date.... GTAR# WHO Description........................................
* 07/19/99 25437 DJD Added new enchancements.
* 10/14/98 23801 SAP Change copyrights.
* 01/06/98 22758 DJD Subroutine created
************************************************************************
*
* DESCRIPTION:
*
* This subroutine contains all the server code for the graphical
* uniVerse administration tool.
*
* Input arguments: Action - key for action to be taken
* Params - parameters required by the
* particular function being
* performed, field mark separated
*
* Output arguments: OutData - any output from the requested
* function, field mark separated
* Error - error code or 0 if no error
*
*
************************************************************************
SUBROUTINE (AdminCode, Params, OutData, Error)
PRINT AdminCode: " ": Params
$INCLUDE UNIVERSE.INCLUDE MACHINE.NAME
$INCLUDE UNIVERSE.INCLUDE PACTERR.H
$INCLUDE UNIVERSE.INCLUDE PACTCMN.H
DEFFUN UVREADMSG(num, args) CALLING '*UVREADMSG'
DEFFUN IsFullPath(a) CALLING '*IS.FULLPATH'
DECLARE GCI access
EQU Text To Out ; * Horrible hack
EQU CRLF To Char(13):Char(10)
EQU CR To Char(13)
EQU TAB To Char(9)
EQU DEFPERMS To 777 ; * Default permissions
EQU SHM.TO.LOAD To "SHM.TO.LOAD"
EQU UVCONFIG To "uvconfig"
EQU GROUPLOCK To 1 ; * Used by lock admin.
EQU RECORDLOCK To 2 ; * Used by lock admin.
EQU FILELOCK To 3 ; * Used by lock admin.
EQU TEMPREC To "VMUVADTMP" ; * Temporary record name
* Layout of config files:
EQU INITIAL$PATTERN TO '"####"0X' ; * end of copyright section
EQU COMMENT$PATTERN TO '"#"0X' ; * general comment introducer
EQU COMMENT$CHAR TO '#'
* Set up array containing paths which MUST NOT be deleted
EQU DONOTDELETE To '/':@FM:'/bin':@FM:'/usr/bin':@FM:'/usr/sbin':@FM:'/etc':@FM:'/dev':@FM:'/usr'
EQU MASTER.ACCOUNTS To "UV" : @FM : "uv" : @FM : "HS.ADMIN" : @FM : "HS.SALES" : @FM : "HS.SERVICE"
EQU F$OK To 0 ; * File exists
EQU X$OK To 1 ; * Execute access
EQU W$OK To 2 ; * Write access
EQU R$OK To 4 ; * Read access
* List of &DEVICE& codes which specify tape devices:
EQU TAPE.DEVICE.PATTERN To "'DT'":@VM:"'DC'":@VM:"'T'":@VM:"'C'"
************************
* OS specific code end *
************************
* Set up pathname and command separators for this operating system. If
* this becomes available in MACHINE.NAME, remove this code
**************************
* OS specific code start *
**************************
OS.SEP = "\"
OS.CMDSEP = " && "
OS.CD = "cd /d "
************************
* OS specific code end *
************************
OutData = ""
Error = 0
AdminCode += 1
KeepFileOpen = False
UnixFileOpen = False
* Set NLS mapping for reading os files
If System(100) Then
Execute "SET.SEQ.MAP OS" Capturing Out
End
If DEBUGGING Then
LogText = "AdminCode = ":AdminCode
Gosub WriteDbg
LogText = "Params = ":Change(Params, @fm, "^]")
Gosub WriteDbg
End
**********************************************************************
* Gosub based on AdminCode
*
* Grouping is:
*
* 1 - 20 Miscellaneous
* 21 - 30 Device Maintenance
* 31 - 40 Account Maintenance
* 41 - 50 Catalog shared memory
* 51 - 70 Spooler
* 71 - 80 Config Editor
* 81 - 90 User administration
* 91 - 100 Lock administration
* 101 - 110 UniVerse Command
* 111 - 120 Network Services
* 121 - 140 Transaction logging
* 141 - 150 Backup/Restore
* 151 - 160 Import account
*
*********************************************************************
On AdminCode Gosub Initialise,
OSBrowse, ; * 1
UniVerseBrowse,
GetDrives,
GetUVHome,
GetAccountPath,
GetFilePath,
DeviceList,
AccountList,
GetDevice,
CheckDirectoryPath,
GetAccountFiles, ; * 11
AcctrstCommand,
ConvertDict,
ConvertVoc,
ConvertPgms,
GetRestoreInfo,
CheckAccountDetails,
AddAccount
If DEBUGGING Then
LogText = "OutData = ":Change(OutData, @fm, "^]")
Gosub WriteDbg
LogText = "Error = ":Error
Gosub WriteDbg
End
RETURN
**********************************************************************
* AccountList - Returns list of accounts on the server
*
* Input: NONE
* Output: Field mark separated list of account
* names
**********************************************************************
AccountList:
Id = ""
Pos = 0
OutData = ""
SSelect UVACCOUNT
Done = False
Loop
ReadNext Id Else Done = True
Until Done Do
Locate Id in MASTER.ACCOUNTS Setting Pos Else
OutData<-1> = Id
End
Repeat
Return
**********************************************************************
* AcctrstCommand - Set up command line for account.restore
*
* Input: Restore directory
* Device name
* Block size
* Use Type19 flag
* Flavour (P = PICK, M = Reality,
* I = IN800, J = IN500)
* Multi save flag (only used for Reality)
* Number of volumes (only used for IN500
* with tape type DC)
* Output: Command line
**********************************************************************
AcctrstCommand:
TapeType = ""
OutData = ""
RstPath = Params<1>
DevName = Params<2>
BlockSize = Params<3>
Flavour = Params<4>
MultiSave = Params<5>
NumVols = Params<6>
FilterName = Params<7>
NumToSkip = Params<8>
CreateDir = Params<9>
* Get device pathname from &DEVICE& file and check that the
* rewind device can be read from
Read DevRec From DEVICES, DevName Else
Error = EADM.CANTREAD
Goto ExitAcctrstCommand
End
EXECUTE "ASSIGN ":DevName:" TO MTU 0" CAPTURING OUTPUT
IF OUTPUT[1,5] = "Error" Then
Error = EADM.UNABLEOPENDEV
Goto ExitAcctrstCommand
End
EXECUTE "UNASSIGN ":DevName
DevPath = DevRec<2>
DevRewind = DevRec<6>
DevType = DevRec<4>
If DevType = "C" Or DevType = "DC" Then
TapeType = " -c"
End
* Change to directory
If CreateDir Then
Command = "mkdir ":RstPath
Command := OS.CMDSEP : OS.CD
End Else
Command = OS.CD
End
* Validation finished, set up the command line
Command := RstPath : OS.CMDSEP
If DevType = "F" Then
If FilterName <> "" Then
Command := " " : UVHOMEBIN : "uvmt -d" : DevPath : " -b" : BlockSize : TapeType : " -fread" : " | " : UVHOME:OS.SEP:"UVTapeFilters": OS.SEP : FilterName : " | " : UVHOMEBIN : "acct.restore.exe -"
End Else
* Use standard restore feature
Command := " " : UVHOMEBIN : "acct.restore"
Command := " -t " : DevName
End
End Else
* Add one uvmt fwd for each file to skip
If NumToSkip > 0 Then
Command:= " " : UVHOMEBIN : "uvmt -d" : DevPath : " -b" : BlockSize : TapeType : " rew" : OS.CMDSEP
For lp = 1 To NumToSkip
Command := " " : UVHOMEBIN : "uvmt -d" : DevPath : " -b" : BlockSize : TapeType : " fskip" : OS.CMDSEP
Next lp
End
If FilterName <> "" Then
Command := " " : UVHOMEBIN : "uvmt -d" : DevPath : " -b" : BlockSize : TapeType : " fread" : " | " : UVHOME:OS.SEP:"UVTapeFilters": OS.SEP : FilterName : " | " : UVHOMEBIN : "acct.restore.exe -" : OS.CMDSEP
End Else
* Use standard restore feature
Command := " " : UVHOMEBIN : "tapein -ice "
Command := TapeType
Command := " -p" : UVHOMEBIN : "acct.restore"
Command := " -f" : DevPath
Command := " -b" : BlockSize
End
End
ExitAcctrstCommand:
If Error = 0 Then
OutData = OS.EXEC : " " : Quote(Command)
End
Return
**********************************************************************
* AddAccount - Add account entry to uv.accounts
*
* Input: Account Details
* Output: Nothing - only an error code
**********************************************************************
AddAccount:
AccountName = Params<1>
AccountPath = Params<2>
Read Temp From UVACCOUNT, AccountName Then
OutData = 0
End Else
Temp<11> = AccountPath
Write Temp To UVACCOUNT, AccountName Else
Error = EADM.CANTWRITE
End
OutData = 1
End
Return
************************************************************************
* CheckAccountDir - Checks the state of an account with respect to
* the directory being deleted: finds out if there
* are any distributed files in the account; finds
* out if the account directory is a home directory
* for any users.
*
* If the account cannot be accessed (or does not
* exist), then an error will be returned together
* with the pathname of the account.
*
* Input: Account Name
* Output: Account Path
* PartFilesFlag (true if distributed files
* in the account)
* HomeDirFlag (true if directory is the
* home directory for any
* users) (unix only)
* Synonym accounts
* (list of UV.ACCOUNT entries
* which use the same directory,
* or null)
* User list (list of users for whom
* the directory is their
* home directory - only
* present if HomeDirFlag is
* true) (unix only)
************************************************************************
CheckAccountDir:
AccName = Params<1>
PartFlag = 0
HomeDirFlag = 0
UserList = ""
Readv AccPath From UVACCOUNT, AccName, 11 Else
Error = EADM.CANTREAD
Return
End
If Trim(AccPath) = "" Then
Error = EADM.BADPATH
Return
End
* First check that there is an accessible account in this directory
* - if there isn't, then the other things are irrelevant
AccVoc = AccPath : OS.SEP : "VOC"
If access(AccVoc, R$OK + W$OK) Then
* We don't have access, check if the VOC actually exists
Error = EADM.NOACCESS
If access(AccVoc, F$OK) Then
* VOC doesn't exist - check the directory
Error = EADM.BADACCOUNT
If access(AccPath, R$OK + W$OK) Then
* No access to directory, check if it exists
Error = EADM.NOACCESS
If access(AccPath, F$OK) Then
* No directory
Error = EADM.NODIRECTORY
End
End
End
OutData = AccPath
Return
End
* We can only get here if the account is accessible.
* Check if this account contains distributed files
**************************
* OS specific code start *
**************************
If OS.TYPE = "MSWIN" Then
Open "&PARTFILES&" TO Partfiles Else
Error = EADM.CANTOPEN
Return
End
UAccPath = Upcase(AccPath)
UAccPathLen = Len(UAccPath)
Select Partfiles To 1
Done = False
Loop
ReadNext Id From 1 Then
If Upcase(Id[1, UAccPathLen]) = UAccPath Then
Done = True
PartFlag = 1
End
End
Else
Done = True
End
Until Done
Repeat
ClearSelect 1
End
************************
* OS specific code end *
************************
* Check if there are other accounts using this directory
SynonymAccs = ""
SSelect UVACCOUNT
Done = False
Loop
ReadNext Id Else Done = True
Until Done Do
If Id # AccName Then
ReadV Path From UVACCOUNT,Id,11 Else Path = ""
**************************
* OS specific code start *
**************************
* On NT the synonym check is case insensitive
If Upcase(Path) = Upcase(AccPath) Then
SynonymAccs<-1> = Id
End
************************
* OS specific code end *
************************
End
Repeat
SynonymAccs = Lower(SynonymAccs)
**************************
* OS specific code start *
**************************
************************
* OS specific code end *
************************
OutData<1> = AccPath
OutData<2> = PartFlag
OutData<3> = HomeDirFlag
OutData<4> = SynonymAccs
OutData<5> = UserList
Return
**********************************************************************
* CheckAccountDetails - Check Account details in UV.ACCOUNTS
*
* Input: Account Name
* Output: Nothing - only an error code
**********************************************************************
CheckAccountDetails:
AccountName = Params<1>
Read Temp From UVACCOUNT, AccountName Then
OutData = 0
End Else
OutData = 1
End
Return
**********************************************************************
* CheckDirectoryPath - Verify that a given path represents an
* existing directory.
*
* Input: pathname
* Output: Nothing - only an error code
**********************************************************************
CheckDirectoryPath:
FilePath = Params<1>
OpenPath FilePath To Temp.File Then
Status Stats From Temp.File Else Stats = ""
Close Temp.File
If Stats<21> = 1 Or Stats<21> = 19 Then
* It's a directory
End Else
* Some other kind of file
Error = EADM.BADDIRECTORY
End
End Else
* Could not open it at all
Error = EADM.NODIRECTORY
End
Return
**********************************************************************
* Convert Dict - Convet a dictionary to UniVerse
*
* Input: Filename
* Output: Code
**********************************************************************
ConvertDict:
FILE = Params<1>
OutData =""
Open "DICT", FILE To DFV Else
Error = EADM.CANTOPEN
Return
End
OutData<-1> = "Converting DICT " : FILE
* Select all the records in the Dict.
sselect DFV ; * Use SELECT list 2 for item list
* Select all dict records, convert to universe format and write back.
loop
readnext ITEM.NAME else null
While ITEM.NAME Do
read dict.item from DFV, ITEM.NAME else
OutData<-1> = "SELECTed item '": ITEM.NAME : "' cannot be read from DICT " : FILE : "."
Error = EADM.CANTREAD
return
end
If ITEM.NAME[ 1, 6 ] <> "&PICK." and ITEM.NAME <> "@ID" then
* Convert items with A or S D/TYPES. Copy any others as they are. >>
skip.item = False ; * Convert or not?
dict.item< 1 > = trim( dict.item< 1 >)
dict.item< 2 > = trim( dict.item< 2 >)
begin case
case ITEM.NAME = FILE or ITEM.NAME = "DL/ID"
delete DFV, ITEM.NAME ; * Will change to "@ID"
dict.item< 1 > = "A" ; * In Pick, is "D"
dict.item< 2 > = 0 ; * In Pick, is the base frame
dict.item< 3 > = ITEM.NAME ; * In Pick, is the modulo
case dict.item< 1 >[ 1, 1 ] = "A" or dict.item< 1 >[ 1, 1 ] = "S"
if Not(num(dict.item<2>)) and count( dict.item<2>, @VM ) then
OutData<-1> = "Non-numeric A/AMC: " : ITEM.NAME : "not processed."
skip.item = True
end
case 1
OutData<-1> = "Unconvertible D/TYPE: " : ITEM.NAME : "not processed."
skip.item = True
end case
if not(skip.item) then
* convert it, then write it.
assoc.item = ""
assoc.name = ""
result = ""
call *DC.ITEM( dict.item, assoc.name, assoc.item, result )
dict.item = Lower(dict.item)
if result then
OutData<-1> = dict.item: " Converted."
end else
OutData<-1> = dict.item: "Not Converted."
end
dict.item = RAISE(dict.item)
write dict.item on DFV, ITEM.NAME else
Error = EADM.CANTWRITE
end
end else
OutData<-1> = "Item ":ITEM.NAME:" Skipped"
end
end else
OutData<-1> = "Item ":ITEM.NAME:" Skipped"
end
repeat
* Create the "@" dictionary entry to control listings. >>
at.phrase = ""
quit.loop = False
for i = 1 to 100 until quit.loop
read xx from DFV, i then
if xx<1>[1,1] # 'X' then at.phrase := " " : i
end else
quit.loop = True
end
next i
at.phrase = trim( at.phrase )
if at.phrase then
at.rec = ""
at.rec< 1 > = "PH"
at.rec< 2 > = at.phrase
write at.rec on DFV, "@"
end else
delete DFV, "@"
end
* Put in an @ID record if one does already exist.
read dict.item from DFV, "@ID" else
dict.item = ""
dict.item< 1 > = "D"
dict.item< 2 > = 0
dict.item< 4 > = FILE
dict.item< 5 > = "10R"
dict.item< 6 > = "S"
write dict.item on DFV, "@ID"
end
Close DFV
Return
**********************************************************************
* Convert pgms - Convert a program file and records
*
* Input: Filename
* Output: Output & Code
**********************************************************************
ConvertPgms:
file.type = 1
Dummy = ""
ProgramKey = ""
OutData = ""
ReturnCode = -1
* Get the params from the client
PgmsFilename = Params<1>
Type19 = Params<2>
Open "", PgmsFilename To PgmsFile Else
Error = EADM.CANTOPEN
Return
End
Open "DICT", PgmsFilename To DictPgmsFile Else
Error = EADM.CANTOPEN
Return
End
OutData<-1> = "Processing program file ":PgmsFilename:"."
OutData<-1> = "Deleting object code"
* Delete the old object code.
SELECT DictPgmsFile
Loop
Readnext ProgramKey else Null
while ProgramKey Do
Readv Dummy From PgmsFile, ProgramKey, 0 Then
DELETE DictPgmsFile, ProgramKey Else
Error = EADM.CANTWRITE
End
End
Repeat
Print "After DICT"
SELECT PgmsFile
Loop
Readnext ProgramKey else Null
while ProgramKey Do
* Run precompiler on the records.
Print "Before Precomp" : ProgramKey
PreComp.Filename = UVHOME:OS.SEP:"CONVERT.PRECOMP"
Call *PRECOMP.SUB(PreComp.Filename, PgmsFilename, PgmsFilename, ProgramKey, ReturnCode)
Print "After Precomp"
If ReturnCode Then
Error = ReturnCode
* Close the files now, NT will not let us resize an open file.
Close PgmsFile
Close DictPgmsFile
Return
End Else
OutData<-1> = ProgramKey:" has been precompiled"
End
Repeat
Print "After Pgms"
* Close the files now, NT will not let us resize an open file.
Close PgmsFile
Close DictPgmsFile
* Resize file
If Type19 Then
file.type = 19
End Else
file.type = 1
End
OutData<-1> = "Resizing program file to type ":file.type
PERFORM "RESIZE " : PgmsFilename :" ": file.type
OutData<-1> = "File resized"
Return
**********************************************************************
* Convert Voc - Convert a the MD to a UniVerse VOC
*
* Input:
* Output: Output & Code
**********************************************************************
ConvertVoc:
sub = 0
code = 0
ccode = 0
Type = 0
nosupport = ""
noconvert = ""
convertok = ""
vocexists = ""
* Get the pick type from client
PickType = Params<1>
RemoveLogin = Params<2>
If PickType[1,5] = "Mentor" Then
PickType = "ADDS"
End Else
PickType = "IBM"
End
Open "", "PICK.VOC" To PVOC Else
Error = EADM.CANTOPEN
Return
End
Open "", "VOC" To UVOC Else
Error = EADM.NOVOC
Return
End
Open "", "BASE_FILE" To BASEFILE Else
Error = EADM.CANTOPEN
Return
End
Open "", "NEWACC" To NEWACCFILE Else
Error = EADM.CANTOPEN
Return
End
MapFilename = UVHOME: OS.SEP: "CVI": OS.SEP: PickType
OpenPath MapFilename To MAPFILE Else
Error = EADM.CANTOPEN
Return
End
Select PVOC
Loop
ReadNext ID Else Null
While ID DO
Read item From PVOC, ID ELSE
Error = EADM.CANTREAD
Return
End
type = item[1,1] ;
if type='P' and item[2,1]='Q' then
type="PQ"
end
if type='M' and item[2,1]='E' then
type='ME'
end
begin case
case type='P'
sub = 1
code = 1
case type='C'
sub = 2
code = 3
case type='D'
sub = 3
code = 4
case type='A'
sub = 4
code = 7
case type='S'
sub = 4
code = 7
case type='X'
sub = 5
code = 7
case type='Q'
sub = 5
code = 5
case type='PQ'
sub = 5
code = 6
case type='M'
sub = 6
code = 6
case type='N'
sub = 6
code = 6
case type='ME'
sub = 6
code = 6
case 1
sub = 5
code = 8
type = "?"
end case
on sub gosub PICK.VERB, CONNECTIVE, PICK.FILE, PICK.DICT, STUFF, PICK.MACRO
Repeat
* Check and remove the login command if one exists.
If RemoveLogin then
Execute "WHO" Capturing Output
AccountName = UpCase( Field(Output, " ", 2))
Gosub CheckRemoveLogin:
If Error = 0 Then
AccountName = DownCase(AccountName)
Gosub CheckRemoveLogin:
End
If Error = 0 Then
AccountName = "LOGIN"
Gosub CheckRemoveLogin:
End
End
Close PVOC
Close UVOC
OutData = "Items Converted to the VOC File": @FM : convertok
OutData:= @FM : @FM: "Items that already exist in the VOC File": @FM : vocexists
OutData:= @FM : @FM: "Items that are not supported": @FM : nosupport
OutData:= @FM : @FM: "Items that have not been converted": @FM : noconvert
Return
PICK.VERB:
n = dcount(item,@fm)
cvt = item<1>
for i=2 to n
cvt := "*":item<i>
next
loop
while cvt[1]='*' do
cvt = cvt[1,len(cvt)-1]
repeat
GENERAL.VERB:
is.cat = ( item<2> = "E6" )
if is.cat then
code+=1
end
gosub MAP
if not( is.cat ) then
convert "-" to "." in ID
end
begin case
case ccode = 0
gosub CHECK.VOC
case ccode = 1
nosupport<-1> = ID
case ccode = 2
if is.cat then
If PickType = "ADDS" Then
cat.para := @AM : "CATALOG " : item< 5 > : " " : ID
End Else
cat.para := @AM : "CATALOG " : item< 6 > : " " : ID
End
end else
noconvert<-1> = ID
end
end case
Return
KEYWORD:
n = dcount(item,@fm)
cvt = "K"
for i=2 to n
cvt := "*":item<i>
next
loop
while cvt[1]='*' do
cvt = cvt[1,len(cvt)-1]
repeat
gosub MAP
gosub CHECK.MAP
return
CONNECTIVE:
cvt = item<1>
gosub MAP
gosub CHECK.MAP
return
PICK.FILE:
read bitem from BASEFILE,item<2> then
fnam = bitem<2>
end else
fnam = ID
end
gosub EFTOIF
citem = "F":@FM:pnam:@FM:"D_":pnam
gosub CHECK.VOC
return
PICK.DICT:
citem = item
assoc.item = ""
assoc.name = ""
flag = ""
call *DC.ITEM(citem , assoc.name , assoc.item , flag )
gosub CHECK.VOC
return
PICK.MACRO:
begin case
case type = "M" or type = "N"
citem = "PQ"
no.atts = dcount(item,@AM)
for i.att = 2 to no.atts
citem<-1> = 'H':item<i.att>
citem<-1> = 'P'
next i.att
item = citem
case type = "ME"
options = ""
helps = ""
commands = ""
no.prompts = dcount(item,@AM)
for i.prompt = 3 to no.prompts
options<-1> = item<i.prompt,1>
helps<-1> = item<i.prompt,2>
commands<-1> = item<i.prompt,3>
next i.prompt
citem = 'PQ'
citem<-1> = 'C'
citem<-1> = '97 C Print menu screen'
citem<-1> = 'T C'
citem<-1> = 'T (':40-(len(item<2>)/2):',1), "':item<2>:'"'
no.options = dcount(options,@AM)
if no.options > 30 then no.options = 30
ypos = 3
xpos = 5
if no.options <= 15 then xpos = 20
for i.option = 1 to no.options
if i.option = 16 then
xpos = 40
ypos = 3
end
text.prompt = oconv(options<i.option>,'T26')
text.prompt = oconv(i.option:".", 'L#4'):' ':text.prompt
citem<-1> = 'T (':xpos:',':ypos:'), "':text.prompt:'"'
ypos = ypos + 1
next i.option
citem<-1> = 'C'
citem<-1> = '98 C Print prompt and handle selection entry'
citem<-1> = 'RI'
citem<-1> = 'RO'
citem<-1> = 'T (0,20), (-4), (20,20), "Selection", +'
citem<-1> = 'S1'
citem<-1> = 'IP:'
citem<-1> = 'IF A1 = "" GO 99'
citem<-1> = 'IF A1 < 1 GO 98'
citem<-1> = 'IF A1 > ':no.options:' GO 98'
citem<-1> = 'GO A1'
citem<-1> = 'C'
for i.option = 1 to no.options
citem<-1> = i.option:' C Menu Selection #':i.option
citem<-1> = 'IF A1 = (0N) GO ':i.option:i.option
citem<-1> = 'C Display the help message'
no.helps = dcount(helps<i.option>,@VM)
for i.help = 1 to no.helps
citem<-1> = 'O ':helps<i.option,i.help>
next i.help
citem<-1> = 'O'
citem<-1> = 'O Return to continue...'
citem<-1> = 'IP '
citem<-1> = 'G 97'
citem<-1> = i.option:i.option:' C Execute command'
no.commands = dcount(commands<i.option>, @VM)
citem<-1> = 'H':commands<i.option,1>
if no.commands > 1 then
citem<-1> = 'STON'
for i.command = 2 to no.commands
citem<-1> = 'H':commands<i.option,i.command>
citem<-1> = 'H<'
next i.command
end
citem<-1> = 'P'
citem<-1> = 'G 97'
citem<-1> = '99 X'
next i.option
item = citem
end case
STUFF:
cvt = type : "*" : ID
gosub MAP
begin case
case ccode = 0
gosub CHECK.VOC
case ccode = 1
nosupport<-1> = ID
case ccode = 2
citem = item
gosub CHECK.VOC
end case
return
MAP:
read mitem from MAPFILE, cvt then
mtype = mitem<2>
cid = mitem<3>
begin case
case mtype = "C"
ccode = 0
read citem from NEWACCFILE, cid else citem = ""
case mtype = "S"
ccode = 0
citem = "S":@fm:cid
case mtype = "P"
ccode = 0
citem = "PH":@fm:cid
case 1
ccode = 1
citem = ""
end case
end else
ccode = 2
citem = ""
end
citem<1> = citem<1>[1,if citem<1>[1,1] = "P" then 2 else 1]
return
CHECK.MAP:
begin case
case ccode = 0
gosub CHECK.VOC
case ccode = 1
nosupport<-1> = ID
case ccode = 2
noconvert<-1> = ID
end case
return
CHECK.VOC:
loop
while citem[1]=@fm do
citem = citem[1,len(citem)-1]
repeat
read xitem from UVOC,ID then
xitem<1> = Upcase(xitem[1,1])
loop
while xitem[1]=@AM do
xitem=xitem[1,len(xitem)-1]
repeat
if upcase(xitem[1,1]) = "F" and (citem<1>[2,9999] # "") then
xitem<1> = xitem<1>:citem<1>[2,9999]
write xitem on UVOC,ID
end
if xitem = citem then
convertok<-1> = ID
end else
vocexists<-1> = ID
end
end else
xitem = citem
convertok<-1> = ID
write citem on UVOC,ID
end
return
EFTOIF:
if fnam = '' then
pnam = '?'
end else
if fnam[1,1] = '.' then
pnam='?.' ; m=2
end else
pnam='' ; m=1
end
l = len(fnam)
for j=m to l
c = fnam[j,1]
begin case
case c='?' ; pnam:='??'
case c='/' ; pnam:='?\'
case c='\' ; pnam:='?\'
case c=char(0) ; pnam:='?0'
case 1 ; pnam:=c
end case
next j
end
return
CheckRemoveLogin:
Error = 0
AccountRec = ""
Read AccountRec from UVOC, AccountName Then
Write AccountRec to UVOC, AccountName:".TEMP" Then
Delete UVOC, AccountName Else
Error = EADM.CANTWRITE
End
End Else
Error = EADM.CANTWRITE
End
End
Return
***********************************************************************
* DeviceList - Get list of tapes, printers or "other" devices.
* Tapes and 'other' devices are taken from the
* &DEVICE& file, printers are taken from &DEVICE&
* and (if on unix) the sp.config file.
*
* Input: Key: 0 - list tapes
* 1 - list printers
* 2 - list other devices
* 3 - list default tapes (DT or DC)
* Output: Dynamic array of device names
***********************************************************************
DeviceList:
Key = Params<1>
* First, run through &DEVICE& building up a list of the devices
* of the type requested
MatchString = "DT":@VM:"DC":@VM:"T":@VM:"C":@VM:"F"
SSelect DEVICES
Done = False
Loop
ReadNext Id Else Done = True
Until Done Do
Readv DevType From DEVICES, Id, 4 Else DevType = ''
Convert " " To @fm In DevType
DevType = DevType<1>
Begin Case
Case DevType = "P"
* This is a printer, if that's what the user requested,
* add it to the list
If Key = 1 Then
OutData<-1> = Id
End
Case DevType ="O"
* This is a not a tape or printer, if the user requested 'other
* devices', add it to the list
If Key = 2 Then
OutData<-1> = Id
End
Case DevType Matches MatchString
* This is a tape device, if that's what the user requested,
* add it to the list
If Key = 0 Then
OutData<-1> = Id
End Else
* Also check for request to list default tapes
If Key = 3 And (DevType = "DC" Or DevType = "DT") Then
OutData<-1> = Id
End
End
End Case
Repeat
**************************
* OS specific code start *
**************************
* If the caller asked for a list of printers and we're on a unix
* system, go through the sp.config file and check that there aren't
* any printers in there that aren't in the &DEVICE& file
If OS.TYPE = "UNIX" And Key = 1 Then
SpConfigPath = SPOOL.DIR : "/sp.config"
OpenSeq SpConfigPath To FL Then
Fin = False
Loop
ReadSeq Line From FL Else Fin = True
Until Fin Do
PName = Line[" ", 1, 1]
Find PName In OutData Setting Fmc Else OutData<-1> = PName
Repeat
CloseSeq FL
End
End
************************
* OS specific code end *
************************
Return
**********************************************************************
* GetAccountFiles - Returns a list of files local to an account
*
* Input: Account name or pathname
* Output: Sorted list of file names, separated
* by field marks.
**********************************************************************
GetAccountFiles:
AccountName = Params<1>
If IsFullPath(AccountName) Then
AccountPath = AccountName
End Else
* Specific account name
ReadV AccountPath From UVACCOUNT, AccountName, 11 Else
Error = EADM.CANTREADPATH
Return
End
End
ExLine = \SSELECT VOC WITH F1 LIKE "'F'..."\
ExLine := \ AND F2 UNLIKE "...\:OS.SEP:\..."\
**************************
* OS specific code start *
**************************
* Checking for / on NT as this is still a valid separator in UniVerse files.
If OS.TYPE # "UNIX" Then
ExLine := \ AND F2 UNLIKE ".../..."\
End
************************
* OS specific code end *
************************
Gosub TCLCommand
Done = False
Loop
ReadNext Id From SList Else Done = True
Until Done Do
OutData<-1> = Id
Repeat
Return
**********************************************************************
* GetAccountPath - Returns the pathname of an account
*
* Input: Account name or pathname
* Output: Account path, or empty if the path
* is not a valid account.
**********************************************************************
GetAccountPath:
AccountName = Params<1>
If IsFullPath(AccountName) Then
AccountPath = AccountName
End Else
* Specific account name
ReadV AccountPath From UVACCOUNT, AccountName, 11 Else
Error = EADM.CANTREADPATH
Return
End
End
* Open the VOC file for the specified account
OpenPath AccountPath : OS.SEP : "VOC" To Remote.Voc Then
Close Remote.Voc
OutData = AccountPath
End Else
Error = EADM.BADACCOUNT
End
Return
**********************************************************************
* GetDevice - Returns a device record. For tapes and
* 'other' devices, this comes from the &DEVICE&
* file. For printers, on a unix system, the
* device definition held in sp.config takes
* precedence over the one held in the &DEVICE&
* file. For non-unix, or if there isn't a
* definition for the requested printer in the
* sp.config file, it is read from the &DEVICE&
* file.
*
* Input: Device name
* Device type key: 0 - tape
* 1 - printer
* 2 - other
* Output: Device record
**********************************************************************
GetDevice:
DevName = Params<1>
Key = Params<2>
DevRec = ""
**************************
* OS specific code start *
**************************
* If this is a unix system, and a printer device definition has
* been requested, look for it in the sp.config file first. Even
* if we get a definition from the sp.config file, we still have
* to get the description from the &DEVICE& record
************************
* OS specific code end *
************************
* If we haven't already read the record (ie. its not a printer or
* we're not on a unix system or we are on a unix system but the
* printer wasn't defined in sp.config), read from the &DEVICE& file
If DevRec = "" Then
Read DevRec From DEVICES, DevName Else
Error = EADM.NOTDEVICE
End
End
If Error = 0 Then
OutData = DevRec
End
Return
**********************************************************************
* GetDrives - Returns a list of available drives for use
* with Browse (NT only)
*
* Input: NONE
* Output: List of drives
**********************************************************************
GetDrives:
DECLARE GCI AdmListDrives
num.drives = AdmListDrives(OutData)
Return
**********************************************************************
* GetFilePath - Returns the OS pathname of a given uniVerse
* file, having validated that it exists and
* can be opened.
*
* Input: Account Name or Pathname
* File Name
* Output: Absolute pathname of file
**********************************************************************
GetFilePath:
AccountName = Params<1>
FileName = Params<2>
* Check if the input is an account or path name.
If IsFullPath(AccountName) Then
AccountPath = AccountName
End Else
* If it's not a path name, read the path from UV.ACCOUNT
ReadV AccountPath From UVACCOUNT, AccountName, 11 Else
Error = EADM.CANTREADPATH
GoTo Exit.GetFilePath
End
End
* Open the VOC file for the specified account
OpenPath AccountPath : OS.SEP : "VOC" To Remote.Voc Else
Error = EADM.BADACCOUNT
GoTo Exit.GetFilePath
End
* Check the VOC entry for the specified file
* Do we have a dict?
If Index(FileName, "DICT", 1) Then
FileDict = Field(FileName," ",1)
FileData = field(FileName," ",2)
End Else
FileDict = ""
FileData = FileName
End
* Read from VOC. If item doesn't exist, assume that the name
* given is an OS name relative to the account
Read FileItem From Remote.Voc, FileData Then
If UpCase(FileItem[1,1]) # "F" Then
Error = EADM.BADVOCITEM
GoTo Exit.GetFilePath
End
If Len(FileDict) > 0 Then
FilePath = FileItem<3>
If Len(FilePath) = 0 Then
Error = EADM.BADDICTPATH
GoTo Exit.GetFilePath
End
End Else
FilePath = FileItem<2>
If Len(FilePath) = 0 Then
Error = EADM.BADDATAPATH
GoTo Exit.GetFilePath
End
End
End Else
* No VOC record
FilePath = FileName
End
* Check that the file itself can be opened
If IsFullPath(FilePath) Then
OutData = FilePath
End Else
OutData = AccountPath : OS.SEP : FilePath
End
OpenPath OutData To Temp.File Then
Close Temp.File
End Else
OpenSeq OutData To Temp.File Then
CloseSeq Temp.File
End Else
* Could not open the file either way
Error = EADM.BADFILE
End
End
Exit.GetFilePath:
Close Remote.Voc
Return
**********************************************************************
* GetRestoreInfo - Get the account restore informaton
*
* Input: Account Path
* Output: Restored account details
**********************************************************************
GetRestoreInfo:
Error = 0
OutData = ""
AccountPath = Trim(Params<1>)
AccountPath = AccountPath : "\VOC"
OpenPath AccountPath To Temp.File Then
Read AccountDetails From Temp.File, "RESTORE.ACCOUNT" Then
OutData = AccountDetails
End Else
Error = EADM.CANTREAD
End
Close Temp.File
End Else
Error = EADM.CANTOPEN
End
Return
**********************************************************************
* GetMachineType - Temporary fix until this can be got from
* session properties
*
* Input: NONE
* Output: Machine type: 0 = NT, 1 - unix
**********************************************************************
GetMachineType:
If OS.TYPE = "UNIX" Then
OutData = "1"
end else
OutData = "0"
End
Return
************************************************************************
* GetUVHome - Returns pathname of uv home account
*
* Input: NONE
* Output: uvhome pathname
************************************************************************
GetUVHome:
OutData = UVHOME
Return
***********************************************************************
* Initialise - Opens files and sets up debugging if required
*
* Input: NONE
* Output: UVHome path
* OSExec command
***********************************************************************
Initialise:
UVHOME = System(32)
UVHOMEBIN = UVHOME:OS.SEP:"bin":OS.SEP
Openpath UVHOME:OS.SEP:'VOC' To VOC Else
Error = EADM.NOVOC
Return
End
* Look for VMADMDBG record in VOC. If it's present, switch DEBUGGING on
Read Rec From VOC, "VMADMDBG" Then
DEBUGGING = True
End Else
DEBUGGING = False
End
If DEBUGGING Then
DebugFile = "./Debug_":@UserNo
OpenSeq DebugFile To DEBUGFL Else
Create DEBUGFL Else
DEBUGGING = False
End
Seek DEBUGFL, -1, 2 Else Null
LogText = Oconv(Date(), "D2/"):" ":Oconv(Time(), "MTS")
GoSub WriteDbg
End
End
If DEBUGGING Then
LogText = "Initialising"
GoSub WriteDbg
End
* Before doing anything else, check that user is an administrator
Temp = ""
call *ISUSER.B(0, Temp)
If Temp = 0 Then
Error = EADM.NOTADMIN
Return
End
Openpath UVHOME:OS.SEP:'UV.ACCOUNT' To UVACCOUNT Else
Error = EADM.NOUVACCOUNT
Return
End
Openpath UVHOME:OS.SEP:'&DEVICE&' To DEVICES Else
Error = EADM.NODEVICE
Return
End
**************************
* OS specific code start *
**************************
************************
* OS specific code end *
************************
UVRC.OPEN = False
OutData = UVHOME : @fm : OS.EXEC
Return
**********************************************************************
* OSBrowse - Returns a list of the directories and files
* contained in a specified directory.
*
* The directory to list is determined by
* combining the two input arguments, start
* directory and directory modifier.
*
* Example 1:
*
* Start directory = "/u1/uv"
* Modifier = ".."
*
* Directory listed will be "/u1"
*
* Example 2:
*
* Start directory = "/u1/uv"
* Modifier = "catdir"
*
* Directory listed will be "/u1/uv/catdir"
*
* If the start directory is not specified, then
* the UVHOME directory is used as a default
*
* If the start directory turns out to be a file,
* or if it doesn't exist, then the last component
* of the pathname is removed, and the parent
* directory is listed. If that doesn't exist,
* an error is returned.
*
* Input: Start directory
* Directory modifier
* Output: Modified directory
* List of directories (prefixed by "D") and
* files (prefixed by "F")
**********************************************************************
OSBrowse:
BrowsePath = Trim(Params<1>)
Modifier = Trim(Params<2>)
BrowsePath = Change(BrowsePath, OS.SEP:OS.SEP, OS.SEP)
If BrowsePath <> "" then
Begin Case
Case Modifier = ".." ; * going up a level
BrowsePath = BrowsePath[OS.SEP, 1, Count(BrowsePath, OS.SEP)]
**************************
* OS specific code start *
**************************
If OS.TYPE = "UNIX" Then
* If we've gone back so far that there's nothing left, set
* path to root
If BrowsePath = "" Then
BrowsePath = OS.SEP
End
End Else
* If we've gone so far back we've stripped the separator from
* the drive, put it back
If Len(BrowsePath) = 2 And BrowsePath[2, 1] = ":" Then
BrowsePath := OS.SEP
End
End
************************
* OS specific code end *
************************
Case Modifier = "" ; * no modifier, do nothing
Case 1
* Going down a level. If we're at the top (eg. "/" or "d:\")
* then we don't need to put the separator in
If BrowsePath[Len(BrowsePath), 1] <> OS.SEP Then
BrowsePath := OS.SEP:Params<2>
End Else
BrowsePath := Params<2>
End
End Case
End Else
BrowsePath = UVHOME
End
**************************
* OS specific code start *
**************************
If OS.TYPE = "UNIX" Then
* Request a single column listing with directories suffixed with "/".
* If the pathname does not specify a directory, the result
* will start with the input pathname exactly
ExLine = "ls -p ":BrowsePath
GoSub ShellCommand
If Out[1, Len(BrowsePath)] = BrowsePath Then
* Modify the path and try again
BrowsePath = BrowsePath[OS.SEP, 1, Count(BrowsePath, OS.SEP)]
* If we've gone back so far that there's nothing left, set
* path to root
If BrowsePath = "" Then
BrowsePath = OS.SEP
End
ExLine = "ls -p ":BrowsePath
GoSub ShellCommand
If Out[1, Len(BrowsePath)] = BrowsePath Then
* Failed again - return an error
Error = EADM.NODIRECTORY
Return
End
End
End Else ; * NT
* First try to get the list of directories. This will return
* an error message:
* - "File Not Found" if the parent directory exists but
* the file either doesn't exist or is not a directory
* - "The system cannot find the file specified." or
* "The system cannot find the path specified." if the
* parent directory doesn't exist.
* - "The filename, directory name, or volume label syntax is incorrect" if
* any part of the pathname is incorrect.
* These tests only work if the language is English. For the
* future, we should devise a language-indpendent way of doing
* the browse function.
ExLine = "dir /B/AD ":BrowsePath
GoSub ShellCommand
CheckString = "The filename, directory name, or volume label syntax is incorrect"
If Out[1, Len(CheckString)] = CheckString Then
* Invalid pathname, so give up
Error = EADM.NODIRECTORY
Return
End
CheckString = "The system cannot find the "
If Out[1, Len(CheckString)] = CheckString Then
* The parent directory doesn't exist, so give up
Error = EADM.NODIRECTORY
Return
End
CheckString = "File Not Found"
If Out[1, Len(CheckString)] = CheckString Then
* Modify the path and try again
BrowsePath = BrowsePath[OS.SEP, 1, Count(BrowsePath, OS.SEP)]
* If we've gone so far back we've stripped the separator from
* the drive, put it back
If Len(BrowsePath) = 2 And BrowsePath[2, 1] = ":" Then
BrowsePath := OS.SEP
End
ExLine = "dir /B/AD ":BrowsePath
GoSub ShellCommand
If Out[1, Len(CheckString)] = CheckString Then
If Len(BrowsePath) = 3 And BrowsePath[2, 2] = ":":OS.SEP Then
* No files in root directory - return an empty directory listing
OutData = BrowsePath:@fm:"D.."
Return
End Else
* Failed again - return an error
Error = EADM.NODIRECTORY
Return
End
End
End
End
************************
* OS specific code end *
************************
* Because we don't get the parent directory returned by "ls" or
* "dir", put it in by hand
OutData = BrowsePath:@fm:"D.."
**************************
* OS specific code start *
**************************
If OS.TYPE = "UNIX" Then
* Use a single column listing with directories suffixed with "/".
* The listing we need is already in the variable "Out"
Dc = Dcount(Out,@fm)
For I = 1 To Dc
If Out<I> <> "" then
File = Trim(Out<I>)
If File[Len(File), 1] = "/" Then
OutData<-1> = "D":File[1, Len(File) - 1]
End Else
OutData<-1> = "F":File
End
End
Next
End Else ; * NT
* First use the list of directories. This is already in the
* variable "Out".
Dc = Dcount(Out,@fm)
For I = 1 To Dc
If Out<I> <> "" Then
OutData<-1> = "D":Trim(Out<I>)
End
Next
* Now get the list of files, excluding hidden files
ExLine = "dir /B/A-D-H ":BrowsePath
GoSub ShellCommand
CheckString = "File Not Found"
If Out[1, Len(CheckString)] # CheckString Then
Dc = Dcount(Out, @fm)
For I = 1 To Dc
If Out<I> <> "" Then
OutData<-1> = "F":Trim(Out<I>)
End
Next
End
End
************************
* OS specific code end *
************************
Return
******************************************************************************
* UniVerseBrowse - Like a normal Browse, but instead of browsing the
* OS file system, it browses the uniVerse account/file
* system. The first argument indicates what kind of
* browse (account or file):
* 1 means return all the local files in the account;
* 2 means return all the records in the file.
*
* Input: Key
* Account name to browse
* File name to browse (only if Key = 2)
* Output: List of files or records
******************************************************************************
UniVerseBrowse:
Done = False
BrowseType = Params<1>
AccountName = Params<2>
If BrowseType = 1 then
Write "Q" : @FM : AccountName : @FM : "VOC" : @FM : "D_VOC" On VOC, "BROWSEPTR"
ExLine = "SSELECT BROWSEPTR WITH F1 LIKE F..."
ExLine := " AND F2 UNLIKE ...":OS.SEP:"..."
**************************
* OS specific code start *
**************************
* Checking for / on NT as this is still a valid separator in UniVerse files.
If OS.TYPE # "UNIX" Then
ExLine := " AND F2 UNLIKE .../..."
End
************************
* OS specific code end *
************************
Gosub TCLCommand
Loop
ReadNext Id From SList Else Done = True
Until Done Do
OutData<-1> = Id
Repeat
End Else
FileName = Params<3>
Write "Q" : @FM : AccountName : @FM : FileName : @FM : "D_VOC" On VOC, "BROWSEPTR"
Open "BROWSEPTR" Then
SSelect
ReadList OutData Then Error = False
Close
End
End
Delete VOC, "BROWSEPTR"
Return
***********************************************************************
* Unused - Returns a "Bad Call" error
*
* Input: NONE
* Output: NONE
***********************************************************************
Unused:
Error = EADM.BADCALL
Return
***********************************************************************
* U T I L I T Y R O U T I N E S
* ============= ===============
***********************************************************************
************************************************************************
** CheckPathName
************************************************************************
*CheckPathName:
*
* PathOk = True
* If Not(Convert("; *&[]`$^","",PathName) = PathName ) Then
* PathOk = False
* End
* Return
************************************************************************
* FindAccountName - Tries to match an account path to an account
* name.
*
* Before calling, the Accounts array and AccountNum
* variable need to have been set up and the
* pathname to be matched must be in the variable
* "AccountPath"
*
* If a match is found, the account name will be
* put into the "AccountName" variable. If no match
* is found this will be empty.
************************************************************************
*FindAccountName:
*
* AccountName = ""
*
* For I = 1 To NumAccounts
* If AccountPath = Accounts(I, 2) Then
* AccountName = Accounts(I, 1)
* Goto ExitFindAccountName
* End
* Next I
*
*ExitFindAccountName:
*
* Return
*
***********************************************************************
* ShellCommand
***********************************************************************
ShellCommand:
* Only add the quotes around the line on UNIX. On NT when using DOS /C
* there is no need for them. Also need to escape the & characters using
* ^& on NT and \& on UNIX.
**************************
* OS specific code start *
**************************
If OS.TYPE = "UNIX" Then
Command = OS.EXEC:" '"
For x = 1 to Len(ExLine)
if ExLine[x,1] = "&" Then
Command := "\&"
End Else
Command := ExLine[x,1]
End
Next
Command := "'"
End Else
Command = OS.EXEC:" "
For x = 1 to Len(ExLine)
if ExLine[x,1] = "&" Then
* If we have a '&&' this is the NT Command separator so
* don't convert.
if ExLine[x-1,4] = " && " then
Command := "&"
x += 1
End Else
Command := "^&"
End
End Else
Command := ExLine[x,1]
End
Next
End
************************
* OS specific code end *
************************
Execute Command, Out. > Out
Return
***********************************************************************
* TCLCommand
***********************************************************************
TCLCommand:
Execute ExLine, Out. > Out, Select. > SList
Return
***********************************************************************
* UvCommand
***********************************************************************
UvCommand:
ExLine = UVHOMEBIN:ExLine
Gosub ShellCommand
Return
**********************************************************************
* WriteDbg - log debug text to file
* Expects debug text in LogText variable
**********************************************************************
WriteDbg:
WriteSeq Change(LogText, @fm, Char(10)) On DEBUGFL Else Null
Seek DEBUGFL, 0, 2 Else Null
Return
Reference in New Issue Copy Permalink