From:	MERC::"uunet!CRVAX.SRI.COM!RELAY-INFO-VAX" 20-JUL-1992 10:06:33.79
To:	info-vax@sri.com
CC:	
Subj:	OPCON  3/5

+-+-+-+ Beginning of part 3 +-+-+-+
X*                         Version 1.00    29-May-1992                      *
X*                                                                          *
X****************************************************************************
X
X      implicit none
X
X      include '($sjcdef)'
X      include '($smgdef)'
X      include 'smg_common.for'
X
X      logical verify,quit,full
X
X      integer   sys$suspnd
X      integer   sys$resume
X      integer   sys$delprc
X      integer   length
X
X      integer   status
X      integer   pid
X      integer   terminator
X      integer   choice
X      integer   entry_number
X      integer   process_action_menu
X      integer   reject
X
X      character*15  process_action(10)
X      character*50  log_message
X      character*8   pid_string
X      character*12  username
X
X      process_action(1) = 'Stop Process'
X      process_action(2) = 'Suspend Process'
X      process_action(3) = 'Resume Process'
X
X      process_action(10) = 'Exit'
X
X***************************
X*     SMG stuff again     *
X***************************
X
X      status = smg$create_virtual_display(14,24,process_action_menu,
X     &         smg$m_border,,)
X      status = smg$create_menu(process_action_menu,process_action,
X     &         smg$k_vertical,,,,)
X      status = smg$paste_virtual_display(process_action_menu,pbid,7,30)
X
X      status = smg$select_from_menu(kb,process_action_menu,choice,,,,,
X     &         terminator,,,)
X
X      write (pid_string,'(Z8.8)') pid          !Write PID into string
X
X      if (choice .eq. 10 .or. terminator .eq. smg$k_trm_ctrlz) then
X        quit = .true.
X
X      else if (full) then
X        if (choice .eq. 1) then
X          call yes_no_selection(verify)
X          if (verify) then
X            status = sys$delprc(pid,)
X            log_message = 'Deleted Process ' // pid_string //
X     &                    ' (' // username(1:length(username)) // ')'
X            call append(log_message)
X            if (.not. status) call lib$signal(%val(status))
X          end if
X        else if (choice .eq. 2) then
X          status = sys$suspnd(pid,,)
X          if (.not. status) call lib$signal(%val(status))
X          log_message = 'Suspended Process ' // pid_string //
X     &                  ' (' // username(1:length(username)) // ')'
X          call append(log_message)
X        else if (choice .eq. 3) then
X          status = sys$resume(pid,)
X          if (.not. status) call lib$signal(%val(status))
X          log_message = 'Resumed Process ' // pid_string //
X     &                  ' (' // username(1:length(username)) // ')'
X          call append(log_message)
X        end if
X      else
X        status = smg$create_virtual_display(1,70,reject,smg$m_border,,)
X        status = smg$paste_virtual_display(reject,pbid,11,5)
X
X***********************************************
X*     Reject users from invalid locations     *
X***********************************************
X
X        status = smg$put_line(reject,
X     &  'You must be at the machine room terminal to perform this function.')
X        call getkey(3,terminator)
X        status = smg$delete_virtual_display(reject)
X      end if
X
X      status = smg$delete_virtual_display(process_action_menu)
X
X      end
$ GOSUB UNPACK_FILE

$ FILE_IS = "PROCESS_SELECT.FOR"
$ CHECKSUM_IS = 1798243218
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X      subroutine process_select(full)
X
X****************************************************************************
X*                                                                          *
X*     This subroutine allows the user to select a process from the menu.   *
X*     Various info about each process is obtained and displayed.           *
X*                                                                          *
X*                         Version 1.00    29-May-1992                      *
X*                         Version 1.00    29-May-1992                      *
X*                                                                          *
X****************************************************************************
X
X      implicit none
X     `032
X      include '($jpidef)'
X      include '($smgdef)'
X      include '($ssdef)'
X      include 'smg_common.for'
X           `032
X      structure   /itmlst/
X        union
X          map
X            integer*2 buflen,itmcod
X            integer*4 bufadr,retadr
X          end map
X          map
X            integer*4 end_list
X          end map
X        end union
X      end structure
X     `032
X      structure /jpinfo/
X        integer       auth_priority
X        real          cpu_time
X        character*256 image
X        character*16  program
X        integer       pid
X        character*15  process_name
X        integer       base_priority
X        character*7   terminal
X        character*12  username
X        character*8   cpu
X        character*8   pid_hex
X      end structure
X       `032
X      structure   /iosblk/
X        integer*4 sts,zeroed
X      end structure
X
X      logical quit,full
X     `032
X      integer   authorized_priority
X      integer   base_priority
X      integer   choice
X      integer   cpu_time
X      integer   i,j
X      integer   image_name_len
X      integer   pid_number
X      integer   process_menu
X      integer   process_name_len
X      integer   status
X      integer   sys$getjpiw
X      integer   terminal_len     `032
X      integer   terminator
X      integer   uic_group
X      integer   username_len
X      integer   what_pid `032
X               `032
X      character*12  username
X      character*15  job_action(10)
X      character*15  process_name
X      character*256 image_name
X      character*256 junk
X      character*60  line `032
X      character*7   terminal
X      character*70  label
X      character*71  menu_choices(200)
X      character*8   cpu
X      character*8   pid_hex
X     `032
X      record /itmlst/ jpi_list(10)
X      record /iosblk/ iosb
X      record /jpinfo/ process(200)
X                 `032
X      jpi_list(1).buflen = 4
X      jpi_list(1).itmcod = jpi$_authpri
X      jpi_list(1).bufadr = %loc(authorized_priority)
X      jpi_list(1).retadr = 0
X
X      jpi_list(2).buflen = 4
X      jpi_list(2).itmcod = jpi$_cputim
X      jpi_list(2).bufadr = %loc(cpu_time)
X      jpi_list(2).retadr = 0
X
X      jpi_list(3).buflen = 256
X      jpi_list(3).itmcod = jpi$_imagname
X      jpi_list(3).bufadr = %loc(image_name)
X      jpi_list(3).retadr = %loc(image_name_len)
X     `032
X      jpi_list(4).buflen = 4
X      jpi_list(4).itmcod = jpi$_pid
X      jpi_list(4).bufadr = %loc(pid_number)
X      jpi_list(4).retadr = 0
X     `032
X      jpi_list(5).buflen = 15
X      jpi_list(5).itmcod = jpi$_prcnam
X      jpi_list(5).bufadr = %loc(process_name)
X      jpi_list(5).retadr = %loc(process_name_len)
X     `032
X      jpi_list(6).buflen = 4
X      jpi_list(6).itmcod = jpi$_prib
X      jpi_list(6).bufadr = %loc(base_priority)
X      jpi_list(6).retadr = 0
X     `032
X      jpi_list(7).buflen = 7
X      jpi_list(7).itmcod = jpi$_terminal
X      jpi_list(7).bufadr = %loc(terminal)
X      jpi_list(7).retadr = %loc(terminal_len)
X     `032
X      jpi_list(8).buflen = 12
X      jpi_list(8).itmcod = jpi$_username
X      jpi_list(8).bufadr = %loc(username)
X      jpi_list(8).retadr = %loc(username_len)
X
X      jpi_list(9).buflen = 4
X      jpi_list(9).itmcod = jpi$_grp
X      jpi_list(9).bufadr = %loc(uic_group)
X      jpi_list(9).retadr = 0
X     `032
X      jpi_list(10).end_list = 0
X     `032
X      quit = .false.
X     `032
X      label = 'Pid      Username     Process Name    Program          ' //
X     &        'Terminal    CPU'
X     `032
X      status = smg$create_virtual_display(20,73,process_menu,smg$m_border,,)
X      status = smg$paste_virtual_display(process_menu,pbid,2,4)
X      status = smg$label_border(process_menu,label,,3,smg$m_reverse,,)
X
X      do while (.not. quit)
X     `032
X        i = 0    `032
X `032
X        do j=1,200
X          menu_choices(j) = ' '
X        end do
X       `032
X        what_pid = -1
X       `032
X        do while ((status .and. ss$_nomoreproc) .ne. ss$_nomoreproc)
X          status = sys$getjpiw(,what_pid,,jpi_list,iosb,,)
X         `032
X          if (( (status) .or.`032
X     &       ((status .and. ss$_suspended) .eq. ss$_suspended) ).and.`032
X     &       (uic_group .gt. '10'O)) then
X            i = i + 1
X                     `032
X            write (process(i).pid_hex,'(Z8.8)') pid_number
X            write (process(i).cpu,'(F8.2)') cpu_time / 100.
X       `032
X        !There is a mystery to be solved here.  If the above two lines
X        !are placed after the block of lines below, there is an invalid CALL
X        !to a fortran library error.  I can find no justification for this.
X `032
X            process(i).auth_priority = authorized_priority
X            process(i).cpu_time      = cpu_time / 100.
X            process(i).image         = image_name(1:image_name_len)
X            process(i).pid           = pid_number
X            process(i).process_name  = process_name(1:process_name_len)
X            process(i).base_priority = base_priority
X            process(i).terminal      = terminal(1:terminal_len)
X            process(i).username      = username(1:username_len)
X           `032
X            junk = process(i).image(index(process(i).image,']')+1:)
X            do while (index(junk,']') .ne. 0)   !Isolate program from path
X              junk = junk(index(junk,']')+1:)   !Handles Nested logicals `032
X            end do
X           `032
X            process(i).program = junk(:index(junk,'.')-1)
X       `032
X            menu_choices(i) = process(i).pid_hex // ' '  //`032
X     &                        process(i).username // ' ' //
X     &                        process(i).process_name // ' '  //`032
X     &                        process(i).program // ' '  //`032
V     &                        process(i).terminal // ' ' // process(i).cpu `0
X32
X                 `032
X          end if `032
X        end do
X         `032
X        what_pid = 0                !Reset wildcard operation
X        status = sys$getjpiw(,what_pid,,jpi_list,iosb,,)
X       `032
V        status = smg$create_menu(process_menu,menu_choices,smg$k_vertical,,,,
X)
V        status = smg$select_from_menu(kb,process_menu,choice,,,,,terminator,,
X,)
X `032
X        if (terminator .eq. smg$k_trm_ctrlz) then
X          quit = .true.
X        else`032
X          call process_control(process(choice).pid,process(choice).username,
X     &                         full)
X        end if
X      end do
X     `032
X      status = smg$delete_virtual_display(process_menu)
X     `032
X      end `032
$ GOSUB UNPACK_FILE

$ FILE_IS = "QUEUE_CONTROL.FOR"
$ CHECKSUM_IS = 773764871
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X      subroutine queue_control(queue_name)
X     `032
X****************************************************************************
X*                                                                          *
X*     This subroutine starts, stops, pauses, etc., the queues on the       *
X*     system.                                                              *
X*                                                                          *
X*                         Version 1.00    29-May-1992                      *
X*                         Version 1.00    29-May-1992                      *
X*                                                                          *
X****************************************************************************
X
X      implicit none
X           `032
X      include '($sjcdef)'
X      include '($smgdef)'
X      include 'smg_common.for'
X                 `032
X      structure   /itmlst/
X        union
X          map
X            integer*2 buflen,itmcod
X            integer*4 bufadr,retadr
X          end map
X          map
X            integer*4 end_list
X          end map
X        end union
X      end structure
X     `032
X      structure   /iosblk/
X        integer*4 sts,zeroed
X      end structure
X
X      logical verify,quit
X           `032
X      integer   sys$sndjbcw
X      integer   length
X     `032
X      integer   status
X      integer   i,j,k,l,m,n
X      integer   queue_control_menu
X      integer   choice
X      integer   terminator
X     `032
X      character*24  queue_action(100)
X      character*31  queue_name
X      character*50  log_message
X     `032
X      record /itmlst/ submit_list(6)
X      record /iosblk/ iosb
X     `032
X      submit_list(1).buflen = length(queue_name)
X      submit_list(1).itmcod = sjc$_queue
X      submit_list(1).bufadr = %loc(queue_name)
X      submit_list(1).retadr = 0
X      submit_list(2).end_list = 0
X     `032
X      queue_action(1)  = 'Stop Queue'
X      queue_action(2)  = 'Start Queue'
X      queue_action(3)  = 'Stop and Restart Queue'
X      queue_action(4)  = 'Pause Queue'
X      queue_action(5)  = 'Flush and Restart Queue'
X                        `032
X      queue_action(10) = 'Exit'
X     `032
X      status = smg$create_virtual_display(6,26,queue_control_menu,
X     &         smg$m_border,,)
X      status = smg$create_menu(queue_control_menu,queue_action,
X     &         smg$k_vertical,,,,)
X      status = smg$paste_virtual_display(queue_control_menu,pbid,7,25)
X
X      quit = .false.
X     `032
X      do while (.not. quit)
X        status = smg$select_from_menu(kb,queue_control_menu,choice,,,,,
X     &           terminator,,,)
X
X************************************
X*     Perform requested action     *
X************************************
X
X        if (choice .eq. 10 .or. terminator .eq. smg$k_trm_ctrlz) then
X          quit = .true.
X        else if (choice .eq. 1) then
X          status = sys$sndjbcw(,%val(sjc$_stop_queue),,submit_list,iosb,,)
X          if (status) status = iosb.sts
X          if (.not. status) call lib$signal (%val(status))`032
X          log_message = 'Stopped queue ' // queue_name
X          call append(log_message)
X        else if (choice .eq. 2) then
X          status = sys$sndjbcw(,%val(sjc$_start_queue),,submit_list,iosb,,)
X          if (status) status = iosb.sts
X          if (.not. status) call lib$signal (%val(status))`032
X          log_message = 'Started queue ' // queue_name
X          call append(log_message)
X        else if (choice .eq. 3) then
X          status = sys$sndjbcw(,%val(sjc$_stop_queue),,submit_list,iosb,,)
X          if (status) status = iosb.sts
X          if (.not. status) call lib$signal (%val(status))`032
X          status = sys$sndjbcw(,%val(sjc$_start_queue),,submit_list,iosb,,)
X          if (status) status = iosb.sts
X          if (.not. status) call lib$signal (%val(status))`032
X          log_message = 'Restarted queue ' // queue_name
X          call append(log_message)
X        else if (choice .eq. 4) then
X          status = sys$sndjbcw(,%val(sjc$_pause_queue),,submit_list,iosb,,)
X          if (status) status = iosb.sts
X          if (.not. status) call lib$signal (%val(status))`032
X          log_message = 'Paused queue ' // queue_name
-+-+-+-+-+ End of part 3 +-+-+-+-+-

