🚀 go-pugleaf

Thanks for your help folks, but PLEASE note that I'm NOT the
same George who asked for this!
---------------------  (Forwarded message follows)  ----------------------
Received: by TAOMLR2@MSU ; Thu, 07 Aug 97 15:40:10
Received: from MSU (NJE origin SMTP3@MSU) by MSU.EDU (LMail V1.2a/1.8a) with
 BSMTP id 8893 for <georgeh@MSU>; Thu, 7 Aug 1997 15:40:10 -0400
Received: from tamvm1.tamu.edu (128.194.103.19) by msu.edu (IBM VM SMTP V2R3
   with TCP; Thu, 07 Aug 97 15:40:05 EDT
Received: from TAMVM1.TAMU.EDU by tamvm1.tamu.edu (IBM VM SMTP V2R2)
   with BSMTP id 0544; Thu, 07 Aug 97 14:38:42 CDT
Received: from TAMVM1.TAMU.EDU (NJE origin X226TS@TAMVM1) by TAMVM1.TAMU.EDU
 (LMail V1.2a/1.8a) with BSMTP id 0626; Thu, 7 Aug 1997 14:38:42 -0500
Date:         Thu, 07 Aug 97 14:36:49 CDT
From:         Marceil Geiser <X226TS@tamvm1.tamu.edu>
Subject:      UNHANG exec (HPO version)
To:           George Shedlock

I have the UNHANG exec on my HPO6 system.  I guess you know it will need to
be tweaked for control blocks but here it is for what it's worth.


/*  Program to reset a userid blocked in FORCE/LOGOFF PENDING status,
    or I/O hung status, or any kind of hung status that CAN be undone :-)

           Syntax is:  UNHANG userid <cuu|DSC>  <(DEBUG>

    This  very tricky  program requires  operator privilege  class C  and
    should be run only as last resort,  ie if no other means of restoring
    the account to the user have been found and a SHUTDOWN REIPL would be
    required.

    The optional parameter specifies the address of the console where the
    user is  logged (or  DSC if disconnected),  in case  that information
    cannot be obtained from a "CP Q  U userid" command but can be seen on
    the "CP Q N" list (this can happen at times...)

    The DEBUG  option indicates  that STCPs  are not  to be  executed but
    should be typed at the terminal.

             Written by Eric Thomas <ERIC@FRECP11.BITNET>

    NO right reserved, program may be sent to any system operator
    experiencing this problem but may NOT be sold.                     */

 Address 'COMMAND'
 Trace off
 Arg name ishedisc? . '('options
 debug = (Find(options,'DEBUG') ^== 0)
 If name == '' Then
  Do
    Say 'Missing argument.'
    Exit 24
  End

 cmds = 'DCP LOCATE STCP'
 Do Words(cmds)
    Parse var cmds cmd cmds
    If Word(Diagrc(8,cmd),1) ^== 1 Then Iterate
    Say 'UNHANG requires' cmd 'authority.'
    Exit 100
 End

 Parse Value(Diag(8,'LOCATE' name)) with '=' vmblok . '15'x
 If ^Datatype(vmblok,'X') Then
  Do
    Say name 'not logged on.'
    Exit 45
  End

 vmblok = x2d(vmblok)
 If ishedisc? ^== '' Then Signal NOCPQUERY

/* See if user is disconnected. Disconnect-force him if not the case */
 Parse Value(Diagrc(8,'Q U' name)) with rc . ' -'ishedisc? . '15'x
 If rc ^== 0 Then
  Do
    Say "Hey, that's strange... I can LOCATE" name "but not QUERY USER him!"
    Exit 100
  End

NOCPQUERY:
 If ishedisc? ^== 'DSC' Then
  Do /* Need to disconnect-force him... */
     /* Assuming that X'37C' is ASYSVM (system VMBLOK address) */
     Parse Value(Diag(8,'DCP 37C')) with . ASYSVM . '15'x
     /* Now get console RDEVBLOK address */
     Parse Value(Diagrc(8,'LOCATE' ishedisc?)) with rc .,
       '15'x . . rdevblok . '15'x
     If rc ^== 0 Then
      Do
        Say "Hmmm... Can't LOCATE" ishedisc?"..."
        Exit 100
      End
     rdevblok = x2d(rdevblok)

     /* We will:

         1) Store a 0 in VMTERM (VMBLOK)
         2) Store two 0 in "vmlogo" (RDEVBLOK)
         3) Store system vmblok address in
             "devowner" (RDEVBLOK)
         4) OR the "user is disc" bit in
             VMOSTAT (VMBLOK)                */

     vmterm = d2x(vmblok+36)
     vmostat = d2x(vmblok+90)
     devowner = d2x(rdevblok+40)
     vmlogo = d2x(rdevblok+24)

    /* Obtain current VMOSTAT setting         */
     Parse Value(Diag(8,'DCP' vmostat)) with . vmodata . '15'x
     vmodata = c2x(bitor(x2c(vmodata),'00001000'x))
     Call STCP 'S'vmostat Substr(vmodata,5,2)
     Call STCP vmterm 0
     Call STCP devowner ASYSVM
     Call STCP vmlogo 0 0
  End

/* Main code -- reset some bits here and there in VMBLOK....

   Clear IUCV status -- reset "CP SET XXXX IUCV" flags in VMIUSTA2 */

 vmiusta2 = vmblok+492
 Parse Value(Diag(8,'DCP' d2x(vmiusta2))) with . oldval . '15'x
 newval = c2x(Bitand(x2c(oldval),'FF01FFFF'x))
 Call STCP d2x(vmiusta2) newval

/* Clearing VMRSTAT & VMOSTAT Status

    Clear:   VMOSTAT VMKILL         -- user is no longer to be logged off
                     VMCF, VMIRCF,
                     VMCFRUN        -- user is no longer executing CF

             VMRSTAT VMLOGON+VMLOGOFF+VMIOWAIT+VMEXWAIT

    Set:     VMOSTAT VMSLEEP+VMDISC -- user is disconnected & sleeping */

 vmrstat = vmblok+88
 Parse Value(Diag(8,'DCP' d2x(vmrstat))) with . oldval . '15'x
 newval = c2x(Bitand(x2c(oldval),'D1FFF0FF'x))
 newval = c2x(Bitor(x2c(newval),'00003000'x))
 Call STCP d2x(vmrstat) newval

 Say 'I have now unlocked' name'. Try to log it off using the CP FORCE comma
'INAREA CP FORCE' name
 Exit

STCP:
 If ^debug Then Return Diag(8,'STCP' Arg(1))
 Say '<Debug> STCP' Arg(1)
 Return

Thanks,

Marceil Geiser                     |Texas A&M University
VM Systems Support (CIS)           |Room: 325D Teague
Phone: (409)862-4121               |Pager: (409) 229-9503