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

+-+-+-+ Beginning of part 2 +-+-+-+
X      job_list(4).buflen = 4
X      job_list(4).itmcod = qui$_job_status
X      job_list(4).bufadr = %loc(job_status)
X      job_list(4).retadr = 0
X      job_list(5).end_list = 0
X`032
X`032
X      do while (.not. quit)
X        status  = sys$getquiw(,%val(qui$_cancel_operation),,,,,)  !Reset
X        if (.not. status) call lib$signal (%val(status))
X
X*********************
X*     Set queue     *
X*********************
X`032
X        search_flags = (qui$m_search_all_jobs .or. qui$m_search_wildcard)
X        status  = sys$getquiw(,%val(qui$_display_queue),,queue_list,iosb,,)
X        if (.not. status) call lib$signal (%val(status))
X`032
X        i = 0                                       `032
X     `032
X        do j = 1,200
X          menu_choices(j) = ' '      !Clear old info
X        end do
X
X************************
X*     Get job info     *
X************************
X`032
X        do while (status)
X`032
X          status = sys$getquiw(,%val(qui$_display_job),,job_list,iosb,,)
X          if (.not. status) call lib$signal (%val(status))
X          if (status) status = iosb.sts
X          if (status) then
X            i = i + 1
X`032
X            if ((job_status .and. qui$m_job_aborting) .ne. 0) then
X              job(i).status = 'Aborting'
X            else if ((job_status .and. qui$m_job_holding ) .ne. 0) then
X              job(i).status = 'Holding '
X            else if ((job_status .and. qui$m_job_inaccessible) .ne. 0) then
X              job(i).status = 'Inaccessible'
X            else if ((job_status .and. qui$m_job_pending) .ne. 0) then
X              job(i).status = 'Pending'
X            else if ((job_status .and. qui$m_job_refused) .ne. 0) then
X              job(i).status = 'Refused'
X            else if ((job_status .and. qui$m_job_retained) .ne. 0) then
X              job(i).status = 'Retained'
X            else if ((job_status .and. qui$m_job_starting) .ne. 0) then
X              job(i).status = 'Starting'
X            else if ((job_status .and. qui$m_job_suspended) .ne. 0) then
X              job(i).status = 'Suspended'
X            else if ((job_status .and. qui$m_job_timed_release) .ne. 0) then
X              job(i).status = 'Timed'
X            else if ((job_status .and. qui$m_job_executing) .ne. 0) then
X              job(i).status = 'Executing'
X            end if
X`032
X            write (job(i).entry,'(i4)') entry_number
X            job(i).username = username(1:username_len)
X`032
X            menu_choices(i) = job(i).entry // ' ' // job(i).username //
X     &                        ' ' // job(i).status
X`032
X            entry_number_of_job(i) = entry_number
X`032
X          end if
X        end do
X`032
X        number_of_jobs = i
X`032
X        if (number_of_jobs .gt. 0) then
V          status = smg$create_menu(job_window,menu_choices,smg$k_vertical,,,,
X)
V          status = smg$select_from_menu(kb,job_window,choice,,,,,terminator,,
X,)
X`032
X          if (terminator .eq. smg$k_trm_ctrlz) then
X            quit = .true.
X          else
X            call job_control(entry_number_of_job(choice),job(i).username)
X          end if
X        else           !Option for an empty queue
X          status = smg$erase_display(job_window)
X          status = smg$put_line(job_window,'Queue is Empty')
X          status = smg$read_keystroke(kb,terminator,,3,,,)
X          if (terminator .eq. smg$k_trm_cr .or.
X     &        terminator .eq. smg$k_trm_lf .or.
X     &        terminator .eq. smg$k_trm_ctrlz) then
X            quit = .true.
X          else if (terminator .eq. smg$k_trm_ctrlw) then
X            status = smg$repaint_screen(pbid)
X          end if
X        end if
X      end do
X`032
X      status = smg$delete_virtual_display(job_window)
X`032
X      return
X`032
X      end
$ GOSUB UNPACK_FILE

$ FILE_IS = "LENGTH.FOR"
$ CHECKSUM_IS = 1867808360
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X      function length(string)
X     `032
X************************************************************************
X*     Function to accept a string STRING and calculate                 *
X*     its length LENGTH.  Where here LENGTH is not equal               *
X*     X for a CHARACTER*X character string, but is the last            *
X*     position in the character string where a character is found.     *
X************************************************************************
X
X      implicit none
X
X      character*(*) string,space,null
X      integer       i,length,system_length
X
X      parameter (space=char(32), null=char(0))
X     `032
X      length = 0
X      system_length=len(string)
X     `032
X      do  i = system_length,1,-1
X        if ((string(i:i).ne.space).and.(string(i:i).ne.null)) then
X          length = i
X          return
X        end if
X      end do
X     `032
X      return
X      end
$ GOSUB UNPACK_FILE

$ FILE_IS = "MESSAGE_TRAP.FOR"
$ CHECKSUM_IS = 1711957879
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X      subroutine message_trap
X`032
X***************************************************************************
X*     This subroutine will run when an incoming message is trapped        *
X*     The message display will be brought up.  The user has five          *
X*     seconds to acknowledge the message, and then the pasteboard is      *
X*     unpasted.                                                           *
X***************************************************************************
X     `032
X      implicit none
X     `032
X      include '($smgdef)'
X      include 'smg_common.for'
X     `032
X      logical done
X     `032
X      integer   message_len
X      integer   delay    /5/
X      integer   terminator
X      integer   status
X      integer   messages_id
X     `032
X      character*80  message
X     `032
X      if (.not. done) then
X        done = .true.
V        status = smg$create_virtual_display(1,80,messages_id,smg$m_trunc_icon
X,,)
V        status = smg$create_virtual_display(20,78,old_messages_id,smg$m_borde
Xr,,)
X        status = smg$paste_virtual_display(messages_id,pbid,24,1)
X      end if
X `032
X      status = smg$get_broadcast_message(pbid,message,message_len,)
X      status = smg$put_line(messages_id,message(1:message_len),,,,,,)
X      status = smg$put_line(old_messages_id,message(1:message_len),,,,,,)
X     `032
X      return
X     `032
X      end
$ GOSUB UNPACK_FILE

$ FILE_IS = "OPCON.FOR"
$ CHECKSUM_IS = 525056968
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X      options/extend_source
X      program opcon
X
X****************************************************************************
X*                                                                          *
X*     This is a program which is designed for student operators.           *
X*     Student operators often need to be able to do some system            *
X*     functions, but do not need to do all the things which giving         *
X*     them WORLD and SYSTEM priveledges would allow them too.  Also,       *
X*     OPCON uses a user friendly interface and logs all of the             *
X*     operations it performs.  It must be installed with WORLD and OPER    *
X*     priveledges.                                                         *
X*                                                                          *
X*     OPCON was originally written by Eric Vaandering between May 18       *
X*     and May 29, 1992.  It was written by and for Valparaiso University   *
X*     in VAX Fortran.  No cluster support is included since our site is    *
X*     not clustered.  Perhaps it will work in such an environment.         *
X*                                                                          *
X*     A few of the parts of the program are designed specifically for      *
X*     our site, but it can easily be modified to be widely useful.  Most   *
X*     of these modifications have to do with security (who can run the     *
X*     program and where it can be run from).                               *
X*                                                                          *
X*     I welcome any comments, bug fixes, suggestions, gripes,              *
X*     enhancements, etc.  I only request that you inform me of any         *
X*     modifications you make which you feel might be useful to others      *
X*     and that you not distribute a modified version of the source code.   *
X*     Also, please let me know that you are using the program, and I       *
X*     will provide you with updates as I create them.  And of course,      *
X*     please leave this header intact.                                     *
X*                                                                          *
X*     Eric Vaandering             Addresses:  Eric Vaandering              *
X*     Student Consultant                      Brandt Hall                  *
X*     Valparaiso University                   Valparaiso, IN 46383         *
X*                                                                          *
X*                                             acc_ewv@valpo.bitnet         *
X*                                             acc_ewv@exodus.valpo.edu     *
X*                                     Summer: ewv@anhep3.hep.anl.gov       *
X*                                             ewv@anlhep.bitnet            *
X*                                                                          *
X****************************************************************************
X*                                                                          *
X*                         Version 1.00    29-May-1992                      *
X*                         Version 1.00    29-May-1992                      *
X*                                                                          *
X****************************************************************************
X
X      implicit none
X
X      include '($smgdef)'
X      include '($jpidef)'
X      include 'smg_common.for'
X
X      external message_trap           !routine to handle broadcast messages
X
X      common /queues/  qname
X      common /user/    user_name
X
X      character user_name*12, terminal*8
X
X      logical full,quit
X
X      structure  /itemlist/
X        union
X          map
X            integer*2  buflen , itemcode
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
X      integer   choice
X      integer   menu_id
X      integer   number_of_queues
X      integer   pidadr
X      integer   sys$getjpiw
X      integer   terminator
X      integer   uic,status
X
X      character*22  menu_selection(10)
X      character*31  qname(100)
X
X      record /itemlist/ item(6)
X
X***************************************
X*     Get info on calling process     *
X***************************************
X
X! terminal
X      item(1).buflen = 7
X      item(1).itemcode = jpi$_terminal
X      item(1).bufadr = %loc(terminal)
X      item(1).retadr = 0
X
X! username
X      item(2).buflen = 12
X      item(2).itemcode = jpi$_username
X      item(2).bufadr = %loc(user_name)
X      item(2).retadr = 0
X
X! uic code
X      item(3).buflen = 4
X      item(3).itemcode = jpi$_grp
X      item(3).bufadr = %loc(uic)
X      item(3).retadr = 0
X
X! end of list
X      item(4).end_list = 0
X
X! ask for info
X      status = sys$getjpiw(,,,item,,,)
X      if (.not. status) call lib$signal (%val(status))
X
X      call check(uic,terminal,full)       !Is user authorized to run program?
X
X**********************************
X*     Get the list of Queues     *
X**********************************
X
X      call queue_find(number_of_queues)   !Creates a list of queues on system
X
X***********************************************
X*     Create the menu and set up SMG stuff    *
X***********************************************
X
X      menu_selection(1)  = 'Queue Status Monitor'
X      menu_selection(2)  = 'Control Queue Entry'
X      menu_selection(3)  = 'Control Queue'
X      menu_selection(4)  = 'Display Processes'
X      menu_selection(5)  = 'Broadcast/Send Message'
X      menu_selection(6)  = 'View Old Messages'
X
X      menu_selection(10) = 'Exit'
X
X      status = smg$create_pasteboard(pbid)
X      status = smg$create_virtual_keyboard(kb,'tt',,,0)
X      status = smg$create_virtual_display(7,24,menu_id,smg$m_border,,)
X      status = smg$create_menu(menu_id,menu_selection,smg$k_vertical,,,,)
X      status = smg$paste_virtual_display(menu_id,pbid,9,27)
X      status = smg$set_broadcast_trapping(pbid,message_trap,)
X
X*********************
X*     Main menu     *
X*********************
X
X      do while (.not. quit)
X        status = smg$select_from_menu(kb,menu_id,choice,,,,,terminator,,,)
X        if (choice .eq. 10 .or. terminator .eq. smg$k_trm_ctrlz) then
X          quit = .true.
X        else if (choice .eq. 1) then
X          call queue_monitor                !Monitors status of all queues
X        else if (choice .eq. 2) then        !Allows user to select a queue to
X          call queue_select('job_display')  !view and manipulate jobs
V        else if (choice .eq. 3) then        !Allows user to select a queue an
Xd
V          call queue_select('queue_control')!start, stop, restart, flush queu
Xe
V        else if (choice .eq. 4) then        !Lets user select a process to st
Xop
X          call process_select(full)         !suspend, or resume
X        else if (choice .eq. 5) then        !Allows the user to select a user
X          call user_select                  !to send a message to.
X        else if (choice .eq. 6) then        !Views old messages which were
X          call view_messages                !trapped.
X        end if
X      end do
X
X      status = smg$delete_pasteboard(pbid)
X
X      end
X
X
X      include 'append.for'
X      include 'check.for'
X      include 'convert_status.for'
X      include 'getkey.for'
X      include 'job_control.for'
X      include 'job_display.for'
X      include 'length.for'
X      include 'message_trap.for'
X      include 'process_control.for'
X      include 'process_select.for'
X      include 'queue_control.for'
X      include 'queue_find.for'
X      include 'queue_monitor.for'
X      include 'queue_select.for'
X      include 'send.for'
X      include 'user_select.for'
X      include 'view_messages.for'
X      include 'yes_no.for'
$ GOSUB UNPACK_FILE

$ FILE_IS = "PROCESS_CONTROL.FOR"
$ CHECKSUM_IS = 979146530
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X      subroutine process_control(pid,username,full)
X
X****************************************************************************
X*                                                                          *
X*     This subroutine deletes, suspends, and resumes the processes on      *
X*     the system.  Passed variable are PID of process, username, and       *
X*     access level.                                                        *
X*                                                                          *
X*                         Version 1.00    29-May-1992                      *
-+-+-+-+-+ End of part 2 +-+-+-+-+-

