[Info-vax] Cleaning up license database
Sum1
not at here.com
Sun Aug 14 05:20:39 EDT 2011
Thanks so much!!
On 2011-08-11 05:30:52 +0000, Phillip Helbig---undress to reply said:
> 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