[Info-vax] Cleaning up license database
Phillip Helbig---undress to reply
helbig at astro.multiCLOTHESvax.de
Thu Aug 11 01:30:52 EDT 2011
In article <4e430970$0$11115$c3e8da3 at news.astraweb.com>, Sum1
<not at here.com> writes:
> Some years ago, some kind person (VAXman, JF….? can't remember) posted
> some DCL to clean up old licensed from the database, rather than doing
> it one-by-one by hand….but I can't seem to locate a copy.
>
> If someone has a working version of same, could you please post it here again?
$! Synopsis: This command file disables all the terminated licenses
$! in the active license database, which is defined by
$! the current value of LMF$LICENSE.
$
$! Parameters: None
$
$! Author: Robert Deininger
$! Created: January, 2001
$
$! Version: V2.1 (generation 3)
$
$! Define some simple status codes.
$
$ lic__status = %x10000000
$ lic__success = lic__status + %x0001
$ lic__ctrly = lic__status + %x000C
$
$! Set up interrupt and error handlers.
$
$ status = lic__success
$ on control_y then goto control_y
$ on warning then goto error
$
$! Find subroutine library.
$ gosub jrddcl_init
$
$! Define some useful symbols.
$ say = "write sys$output"
$
$! The real work starts here.
$
$ tempfile1 = "terminated.lis;"
$ tempfile2 = "disable_terminated.com;"
$
$ current_ldb = f$search(f$trnlnm("lmf$license"))
$
$ type sys$input
Utility to DISABLE all the terminated licenses in the active
license database...
The active database is:
$ say " ",current_ldb
$ type sys$input
This utility makes many changes to the license database. Do you
want a backup copy of the database file saved before changes
are made?
$10:
$ on warning then goto 10
$ jrdcall ask lic__answer b "Save a backup copy?" "YES" U,S
$ on warning then goto error
$
$ if lic__answer
$ then
$ current_ldb = current_ldb - f$parse(current_ldb,,,"version")
$ say ""
$! changed copy to backup to preserve dates
$ backup/log 'current_ldb' 'current_ldb'_backup;
$! not needed anymore, but leave in for documentation
$ current_ldb = f$search(f$trnlnm("lmf$license"))
$ say ""
$! say " The new highest version will be modified."
$! added 20-OCT-2007
$ file_spec = f$element(0,";",current_ldb) + ";*"
$! dir/dat=(c,m)/siz=all 'current_ldb'
$ dir/dat=(c,m)/siz=all 'file_spec'
$ endif
$
$ say " Finding terminated licenses..."
$
$! Get a list of terminated licenses.
$ license list/before/terminated/full/output='tempfile1'
$
$ say " Making a command file to disable licenses..."
$
$! Open the input and output files.
$ open/read tempfile1 'tempfile1'
$ open/write tempfile2 'tempfile2'
$
$ target_string = "-----------------------"
$main_loop:
$ gosub find_string
$ if input_string .nes. ""
$ then
$! We have read the "header" line for a single license.
$! Look for expected beginnings on the next 4 lines, and save the good
$! parts.
$
$ get_string = "Issuer:"
$ gosub get_string
$ if result_string .nes. ""
$ then
$ issuer = result_string
$ else
$ goto main_loop
$ endif
$
$ get_string = "Authorization:"
$ gosub get_string
$ if result_string .nes. ""
$ then
$ authorization = result_string
$ else
$ goto main_loop
$ endif
$
$ get_string = "Product Name:"
$ gosub get_string
$ if result_string .nes. ""
$ then
$ product_name = result_string
$ else
$ goto main_loop
$ endif
$
$ get_string = "Producer:"
$ gosub get_string
$ if result_string .nes. ""
$ then
$ producer = result_string
$ else
$ goto main_loop
$ endif
$
$ ! We have the 4 important pieces of information we wanted. Generate
$ ! a LICENSE DISABLE command.
$ gosub write_command
$
$ goto main_loop
$ endif
$
$! We have processed the whole input file.
$ close tempfile1
$ write tempfile2 "$ exit"
$ close tempfile2
$
$20:
$ on warning then goto 20
$ jrdcall ask lic__answer b "Do you want to view the command file?" -
"YES" U,S
$ on warning then goto error
$
$ if lic__answer
$ then
$ type/page 'tempfile2'
$ endif
$
$30:
$ on warning then goto 30
$ jrdcall ask lic__answer b -
"Do you want to execute these commands to modify the license database?" -
"" U,S
$ on warning then goto error
$
$ if lic__answer
$ then
$ @'tempfile2'
type sys$input
Disabling is complete.
You may want to execute
$ LICENSE DELETE */STATUS=DISABLED/LOG
to completely remove all disabled licenses from the database.
$
$ else
$ say ""
$ say " Modifications cancelled."
$ endif
$
$ goto cleanup
$
$CONTROL_Y:
$ status = lic__ctrly
$ goto cleanup
$
$ERROR:
$ status = $status
$ goto cleanup
$
$CLEANUP:
$ if f$search(tempfile1) .nes. "" then delete/nolog/noconfirm 'tempfile1'*
$ if f$search(tempfile2) .nes. "" then delete/nolog/noconfirm 'tempfile2'*
$
$ if f$type(lic__answer) .nes. "" then delete/symbol/global/nolog lic__answer
$
$ exit status .or. %x10000000
$
$FIND_STRING:
$! This subroutine reads lines from tempfile1 until it obtains a line that
$! begins with target_string. It returns with input_string equal to the
$! entire input line, or the null string if the end of the file was reached
$! without finding the target.
$
$find_loop:
$ read/end_of_file=end_of_file tempfile1 input_string
$ if f$locate(target_string,input_string) .eq. 0
$ then
$ ! The current string begins with the target.
$ return ! (FIND_STRING)
$ else
$ goto find_loop
$ endif
$
$end_of_file:
$ input_string = ""
$ return ! (FIND_STRING)
$
$GET_STRING:
$! This subroutine reads a line from tempfile1, checks that it starts
$! with get_string, and returns in result_string the last part of the
$! string. The "last part" is the second element delimited by " ",
$! after the part matching get_string is removed.
$
$ read tempfile1 input_string
$ if f$locate(get_string,input_string) .eq. 0
$ then
$ ! The current string begins with the target.
$ temp = f$edit((input_string - get_string),"compress")
$ result_string = f$element(1," ",temp)
$
$ else
$ say "Unexpected line. Expected ''get_string', found:"
$ say line
$ say ""
$
$ result_string = ""
$ endif
$
$ return ! (GET_STRING)
$
$WRITE_COMMAND:
$! This subroutine writes a single "license disable" command to tempfile2,
$! using the information in symbols PRODUCT_NAME, AUTHORIZATION, ISSUER,
$! and PRODUCER.
$
$ write tempfile2 "$ license disable/log ''product_name' -"
$ write tempfile2 " /authorization=''authorization' -"
$ write tempfile2 " /issuer=''issuer' -"
$ write tempfile2 " /producer=''producer'"
$ write tempfile2 "$!"
$
$ return ! (WRITE_COMMAND)
$!---------------------------------------
$
$! Title: Initialize symbol pointing to main DCL library file
$
$! Synopsis:
$! This routine attempts to define the symbol JRDCALL to point to
$! my library of DCL routines. The library is either in a standard
$! file located via logical name JRD_JRDDCL (on my own systems/accounts)
$! or appended to this file (for DCL utilities that I distribute).
$! This routine rarely changes; it is convenient to append it to any DCL
$! file that uses JRDDCL.COM.
$! V1.0 (generation 1)
$
$
$JRDDCL_INIT:
$
$! Try the logical name first.
$ jrddcl_file = f$search("jrd_jrddcl")
$ if jrddcl_file .eqs. "" then goto jrddcl_init_nofile
$
$ jrdcall := @'jrddcl_file'
$ jrddcl_subroutine :=
$ call jrddcl_init_try
$ if $status then return
$
$JRDDCL_INIT_NOFILE:
$
$! Look for JRDDCL routines in this file.
$ jrdcall := call jrddcl_call_entry
$ jrddcl_subroutine := subroutine
$ call jrddcl_init_try
$ if $status then return
$
$JRDDCL_INIT_NOTFOUND:
$
$! Neither method worked, give up.
$ delete/symbol jrdcall
$ delete/symbol jrddcl_subroutine
$ write sys$output "Can't find JRDDCL subroutine library."
$ write sys$output "... define logical name JRD_JRDDCL or"
$ write sys$output "... append library to this file."
$ exit
$
$JRDDCL_INIT_TRY:
$ subroutine
$ on warning then exit $status
$ jrdcall test
$ endsubroutine
$
$ exit
$!---------------------------------------
$! DCL subroutine library
$! Modelled after the example in "Writing Real Programs in DCL, 2nd
$! Edition."
$! V2.2 (generation 4)
$
$ goto jrddcl_atsign_entry
$
$! CALL entry point used when this library is appended to another DCL file.
$JRDDCL_CALL_ENTRY:
$ jrddcl_subroutine ! For CALL entry only, symbol substitution makes this
$ ! a SUBROUTINE statement.
$
$! @-sign entry used when this library is in a separate file.
$JRDDCL_ATSIGN_ENTRY:
$
$ jrddcl__status = %x10000000
$ jrddcl__success = jrddcl__status + %x0001
$ on control_y then exit jrddcl__status + %x0004
$ on warning then exit $status .or. %x10000000
$
$ display = "write sys$output"
$ if f$type(jrdcall) .nes. "STRING"
$ then
$ jrdcall = "@" + f$environment("PROCEDURE")
$ endif
$ goto jrddcl_'p1'
$
$! Title: Test accessibility of the DCL library
$
$! Synopsis: This subroutine just returns a success status code. It
$! is intended to allow calling routines to verify that they know
$! how to find the library.
$
$! Parameters:
$! None.
$
$JRDDCL_TEST:
$
$ exit jrddcl__success
$
$! Title: Ask a Question
$
$! Synopsis: This subroutine asks the user a question and returns
$! the answer. The prompt for the question is composed
$! of a query string and optionally a default answer.
$
$! Parameters:
$! P2: A global symbol to receive the answer.
$! P3: The data type of the answer. B for boolean
$! (yes,no); I for integer; S for string.
$! P4: The query string for the question. It must end
$! with a punctuation character and no space.
$! P5: The default answer (optional; if not specified
$! then an answer must be entered).
$! P6: A comma-separated list of options:
$! H: Display help before asking question.
$! S: Skip a line before asking question.
$! U: Upcase the input string.
$! Z: Allow Ctrl/Z as an nswer.
$! P7: The help specifier (optional). It must be in
$! in the form "procedure [parameter...]". The
$! procedure is invoked with the @-sign command.
$
$JRDDCL_ASK:
$
$ signal = jrdcall + " signal ask"
$ if p3 .eqs. "B" .and. p5 .nes. "" .and. f$type(p5) .eqs. "INTEGER"
$ then
$ p5 = f$element(p5,"/","NO/YES")
$ endif
$ if p5 .nes. ""
$ then
$ p4 = f$extract(0,f$len(p4)-1,p4) + -
" [" + p5 + "]" + f$extract(f$len(p4)-1,1,p4)
$ endif
$ if f$locate("S",p6) .ne. f$length(p6) then display ""
$ if f$locate("H",p6) .ne. f$length(p6) then @'p7'
$
$jrddcl_a10:
$ read sys$command/prompt="''p4' " input/end_of_file=a_eof
$ if input .eqs. "" then input = p5
$ input = f$edit(input,"TRIM")
$ if input .eqs. ""
$ then
$ signal w inputreq "Please enter a value; there is no default."
$ else if input .eqs. "?"
$ then
$ if p7 .nes. "" then @'p7'
$ if p7 .eqs. "" then display "There is no help for this question."
$ else
$ goto jrddcl_a_'p3'
$jrddcl_a_B:
$ input = f$edit(input,"UPCASE")
$ if f$locate(input,"YES") .eq. 0 .or. -
f$locate(input,"NO") .eq. 0
$ then
$ input = input .and. 1
$ goto jrddcl_a19
$ else
$ signal w yesnoreq "Please answer YES or NO."
$ endif
$ goto jrddcl_a15
$
$jrddcl_a_I:
$ if f$type(input) .eqs. "INTEGER"
$ then
$ input = f$integer(input)
$ goto jrddcl_a19
$ else
$ signal w intreq "The input must be an integer."
$ endif
$ goto jrddcl_a15
$
$jrddcl_a_S:
$ if f$locate("U",p6) .ne. f$length(p6)
$ then
$ input = f$edit(input,"UPCASE")
$ endif
$ goto jrddcl_a19
$jrddcl_a15:
$ endif
$ endif
$ goto jrddcl_a10
$jrddcl_a_eof:
$ input = "^Z"
$ if f$locate("Z",p6) .ne. f$length(p6) then goto jrddcl_a19
$ signal i invctrlz "End-of-file is not a valid response."
$ goto jrddcl_a10
$jrddcl_a19:
$ 'p2' == input
$ exit jrddcl__success
$
$! Title: Signal an Informational or Error Message
$
$! Synopsis: This subroutine "signals" a message, producing one
$! or more message lines in the standard OpenVMS format.
$! It also exits with a status whose severity matches
$! that of the message.
$
$! Parameters:
$! P2: The message facility code.
$! P3: The message serverity (S, I, W, E, or F).
$! P4: The message identification.
$! P5: The message text.
$! Pn: Optional message lines or status codes whose
$! corresponding message lines are to me included.
$
$! Status: The severity of the exit status is equal to the
$! message severity, except in the case of warnings.
$! If the message severity is W, an informational
$! severity is included in the status so that the
$! caller's error handler is not invoked.
$
$JRDDCL_SIGNAL:
$
$ prefix = f$fao("%!AS-!AS-!AS, ",p2,p3,p4)
$ i = 4
$jrddcl_s10:
$ i = i + 1
$ if i .gt. 8 then goto jrddcl_s19
$ if p'i' .eqs. "" then goto jrddcl_s19
$ text = p'i'
$ if f$type(text) .eqs. "INTEGER"
$ then
$ text = f$message(text)
$ endif
$ if f$ext(0,1,text) .nes. "%" then text = prefix + text
$ if i .gt. 5 then text [0,1] := "-"
$ display text
$ goto jrddcl_s10
$jrddcl_s19:
$ if p3 .eqs. "W" then p3 = "I"
$ exit jrddcl__status + f$locate(p3,"WSEIF")
$
$! Title: Display a Message
$
$! Synopsis: This subroutine outputs a message, producing one
$! or more message lines in the standard OpenVMS format.
$! It exits with an informational status so the caller's
$! error handler is not invoked.
$
$! Parameters:
$! P2: The message facility code.
$! P3: The message serverity (S, I, W, E, or F).
$! P4: The message identification.
$! P5: The message text.
$! Pn: Optional message lines or status codes whose
$! corresponding message lines are to me included.
$
$! Status: Always success. The caller's error handler is not
$! invoked.
$
$JRDDCL_MESSAGE:
$
$ prefix = f$fao("%!AS-!AS-!AS, ",p2,p3,p4)
$ i = 4
$jrddcl_m10:
$ i = i + 1
$ if i .gt. 8 then goto jrddcl_m19
$ if p'i' .eqs. "" then goto jrddcl_m19
$ text = p'i'
$ if f$type(text) .eqs. "INTEGER"
$ then
$ text = f$message(text)
$ endif
$ if f$ext(0,1,text) .nes. "%" then text = prefix + text
$ if i .gt. 5 then text [0,1] := "-"
$ display text
$ goto jrddcl_m10
$jrddcl_m19:
$ p3 = "I"
$ exit jrddcl__status + f$locate(p3,"WSEIF")
More information about the Info-vax
mailing list