2073 lines
62 KiB
Plaintext
Executable File
2073 lines
62 KiB
Plaintext
Executable File
*******************************************************************************
|
|
*
|
|
* 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
|