/****************************************/
		/*					*/
		/*  Author:				*/
		/*					*/
		/*    Ira Winston			*/
		/*    Computer Science Department	*/
		/*    University of Pennsylvania	*/
		/*					*/
		/****************************************/


Set_Ctrlc: Procedure Returns(Fixed Binary(31));

%Include Sys$Assign;
%Include Sys$Qiow;
%Include $Stsdef;

Declare ttchan Fixed Binary(15),	/* terminal channel */
	(IO$_SETMODE,IO$M_CTRLCAST)	/* I/O function codes */
	  Fixed Binary(31) Globalref Value;

Declare 1 Iosb,
	  2 Value Fixed Binary(15),	/* Return status */
	  2 Not_used(3) Fixed Binary(15),
	C_Ast Entry(Pointer),
	C_Interrupt Fixed Binary(31) Static Readonly Init(555);

Declare IO_Success Bit(1) Aligned Based(Addr(Iosb.Value));

  Sts$Value = Sys$Assign('TT',TTchan,,);
  If ^Sts$Success Then Return(Sts$Value);

  Sts$Value = Sys$Qiow (1,TTchan,
			IO$_SETMODE+IO$M_CTRLCAST,
			Iosb,
			,,
			C_Ast,
			Addr(C_Interrupt),
			,,,,);

  If ^Sts$Success Then Return(Sts$Value);
  If ^Io_Success Then Return(Iosb.Value);
  Return(1);
  End Set_Ctrlc;

C_Ast: Procedure (Astparm);

%Include Sys$Clrast;

%Include $Stsdef;

Declare Astparm Fixed Binary(31);

  Sts$Value = Sys$Clrast();
  Signal VaxCondition(Astparm);
  End C_Ast;

/* Prompt user for a command and convert input to command number */
get_command: Procedure (command,input_buffer,arg_start);

  Declare command Fixed Binary(7),
	  input_buffer Character(255) Varying,
	  arg_start Fixed Binary(31),
	  cmd Character(6) Varying,
	  cmdlen Fixed Binary;

  %Include Read_line;

  %Include Commands;


  /* Extract command name from command line */
  If Read_Line('Command: ',input_buffer,cvt2upper) Then Do;
    arg_start = Index(input_buffer,' ');
    If arg_start = 0 Then arg_start = Length(input_buffer) + 2;
    Else arg_start = arg_start + 1;
    cmdlen = Min(arg_start-2,6);
    cmd = Substr(input_buffer,1,cmdlen);
    If cmdlen ^= 0 Then Do;
      cmd = Substr(input_buffer,1,cmdlen);

      /* Convert command name to command number */
      If cmd = Substr('ADD    ',1,cmdlen) Then command = add_command;
      Else If cmd = Substr('DELETE',1,cmdlen) Then command = delete_command;
      Else If cmd = Substr('SHOW  ',1,cmdlen) Then command = show_command;
      Else If cmd = Substr('LIST  ',1,cmdlen) Then command = list_command;
      Else If cmd = Substr('STAT  ',1,cmdlen) Then command = stat_command;
      Else If cmd = Substr('EDIT  ',1,cmdlen) Then command = edit_command;
      Else If cmd = Substr('HELP  ',1,cmdlen) Then command = help_command;
      Else If cmd = Substr('?     ',1,cmdlen) Then command = help_command;
      Else If cmd = Substr('HALT  ',1,cmdlen) Then command = halt_command;
      Else If cmd = Substr('END   ',1,cmdlen) Then command = halt_command;
      Else If cmd = Substr('STOP  ',1,cmdlen) Then command = halt_command;
      Else If cmd = Substr('EXIT  ',1,cmdlen) Then command = halt_command;
      Else command = invalid_command;
      End;
    Else command = null_command;
    End;
  Else command = halt_command;
  End Get_command;

Get_messno: Procedure (input_buffer,arg_start,index_count,messno)
	              Returns(Bit(1));

  Declare input_buffer Character(255) Varying,
	  arg_start Fixed Binary(31),
	  index_count Fixed Binary(31),
	  messno Fixed Binary(31),
	  bad_messno Bit(1) Init('0'b);

  If arg_start > length(input_buffer) Then Do;
    Put Skip List('?No message number specified');
    Return('0'b);
    End;
  messno = 0;
  On Error bad_messno = '1'b;
  Get String(substr(input_buffer,arg_start)) List(messno);
  Revert Error;
  If messno <= 0 | bad_messno Then Do;
    Put Skip List('?Invalid message number');
    Return('0'b);
    End;
  If messno > index_count Then Do;
    Put Skip List('?Message does not exit');
    Return('0'b);
    End;
  Return('1'b);
  End Get_messno;

Index_Access: Procedure(indextree,position,ind_entry);

  Declare (indextree,ind_entry) Pointer,
	  position Fixed Binary(31),
	  count Fixed Binary(31);

  %Include Scan_Index;

  count = 0;
  Call Scan_Index(indextree,index_check,count);
  ind_entry = null();
found:
  Return;
  
  Index_check: Procedure(indextree,count);

    Declare indextree Pointer,
	    count Fixed Binary(31);

    If count = position Then Do;
      ind_entry = indextree;
      GoTo found;
      End;
    End Index_check;

  End index_access;

/* If error_code is 'record locked' pause for a while */
/* Typically called from the ON ERROR unit active during a file read */

Scan_tree: Procedure (tree,action_routine) Recursive;

  Declare tree Pointer,
	  Action_routine Entry(pointer),
	  save_right Pointer;

  %Include treedef;

  If tree ^= Null() Then Do;
    Call Scan_tree(tree->nametree.left,action_routine);
    save_right = tree->nametree.right;		/* In case action is free */
    Call Action_routine(tree);
    Call Scan_tree(save_right,action_routine);
    End;
  End Scan_tree;

Write_Request: Procedure(number_of_lines,line_count);

  Declare (number_of_lines,line_count) Fixed Binary(31);

  Declare input_buffer Character(255) varying;

  %Include Set_Ctrlc;

  %Include Read_line;

  If line_count > 22 Then
    If read_line('More[Y,N]? ',input_buffer,cvt2upper) Then
      If Length(Input_buffer) >= 1 Then
	If Substr(Input_buffer,1,1) = 'N' Then
	  Signal VaxCondition(C_interrupt);
        Else line_count = number_of_lines;
      Else line_count = number_of_lines;
    Else Signal VaxCondition(C_interrupt);
  Else line_count = line_count + number_of_lines;
  End Write_Request;

/* Read a date from user and return a day number */
Read_Date: Procedure (prompt,default_to_today,days);

  Declare prompt Character(*),		/* Prompt message */
	  default_to_today Bit(1),	/* If set then default to today */
	  days Fixed Binary(31);	/* Output - day number */

  Declare time Bit(64) Aligned,
	  input_buffer Character(255) Varying,
	  daytime Fixed Binary(31),
	  done Bit(1) Init('0'b);

  %Include Lib$day;

  %Include $Stsdef;

  %Include Sys$Bintim;

  %Include Read_Line;

  /* Repeat until valid date found */
  Do While (^done);
    If read_line(prompt,input_buffer,cvt2upper) Then Do;
      If Length(input_buffer) > 0 Then Do;
	Sts$Value = Sys$Bintim((input_buffer),time);
	If Sts$Success Then Do;
	  Call Lib$day(days,time);
	  done = '1'b;
	  End;
	End;
      Else If default_to_today Then Do;		/* Default? */
	Call Lib$day(days,,daytime);
	If daytime < 1440000 Then days = days - 1;	/* before 4AM */
	done = '1'b;
	End;
      End;
    End;
  End read_date;

Read_repeat_type: Procedure(reptype);

  Declare reptype Fixed Binary(7),
	  input_buffer Character(255) Varying,
	  done Bit(1);

  %Include read_line;


  Put Skip(2) List ('You have the following choices for message type:');
  Put Skip;
  Put Skip List ('  1 - Display message once');
  Put Skip List ('  2 - Display message once a day');
  Put Skip List ('  3 - Display message once a login');
  Put Skip List ('  4 - Display message once, except for last day');
  Put Skip List ('  5 - Display message once a day, except for last day');
  Put Skip;
  done = '0'b;
  Do While(^done);
    If read_line('Enter message type: ',input_buffer,cvt2upper) Then
      If Length(input_buffer) = 1 Then
	If Verify(Substr(input_buffer,1,1),'12345') = 0 Then done = '1'b;
    End;
  reptype = Fixed(Substr(input_buffer,1,1),7);
  End Read_repeat_type;

Readtext: Procedure (text_list);

  Declare (Null,Length) Builtin;

  Declare text_list pointer,
	  text_ptr pointer Init(Null),
	  ext_length Fixed Binary(15),
	  1 text_list_entry Based(text_ptr),
	    2 link pointer,
	    2 textn,
	      3 timestamp Bit(64) Aligned,
	      3 sequence_no Fixed Binary(7),
	      3 length Fixed Binary(15),
	      3 text Character(ext_length);

  Declare done Bit(1),
	  textfile File Input Stream,
	  (eof_textfile,open_error,textfile_open) Bit(1),
	  count Fixed Binary,
	  input_buffer Character(255) Varying;

  %Include Critical_Section;

  %Include Set_Ctrlc;

  %Include read_line;
 
  %Replace maxtext By 126;

  On VaxCondition(C_interrupt) GoTo Abort;
  Put Skip List('Enter text of message below. Press CTRL/Z when complete:');

  count = 0;
  text_list = Null;
  done = '0'b;
  Do While(^done);
    If Read_line('',input_buffer,nocvt2upper) Then Do;
      If Length(input_buffer) ^= 0 Then Do;
	If Substr(input_buffer,1,1) = '@' Then Do;
	  textfile_open = '0'b;
	  On Endfile(textfile) eof_textfile = '1'b;
	  On UndefinedFile(textfile) open_error = '1'b;
	  open_error = '0'b;
	  Call Start_Critical_Section;
	  Open File(Textfile) Title(Substr(input_buffer,2));
	  If open_error Then Do;
	    Put Skip Edit(Substr(input_buffer,2),' cannot be opened') (A,A);
	    Call End_Critical_Section;
	    End;
	  Else Do;
	    textfile_open = '1'b;
	    Call End_Critical_Section;
	    eof_textfile = '0'b;
	    Get File(textfile) Edit(input_buffer) (A(255));
	    Do While (^eof_textfile);
	      Call addtext(input_buffer);
	      Get File(textfile) Edit(input_buffer) (A(255));
	      End;
	    Call Start_Critical_Section;
	    textfile_open = '0'b;
	    Close File(textfile);
	    Call End_Critical_Section;
	    done = '1'b;
	    End;
	  End;
	Else Call addtext(input_buffer);
	End;
      Else Call addtext(input_buffer);
      End;
    Else done = '1'b;
    End;
  count = 0;
  Call addtext(Byte(26)); 	/* Ctrl-Z termination */
  Return;

Abort:
  If textfile_open Then Close File(textfile);
  Revert VaxCondition(C_interrupt);
  Signal VaxCondition(C_interrupt);
  Return;

  Addtext: Procedure (text);

    Declare text Character(*) Varying;

    count = count + 1;
    If count <= maxtext Then Do;
      ext_length = Length(text);
      Call Start_Critical_Section;
      If text_list = Null Then Do;
        Allocate text_list_entry Set(text_ptr);
        text_list = text_ptr;
        End;
      Else Do;
        Allocate text_list_entry Set(text_ptr->text_list_entry.link);
        text_ptr = text_ptr->text_list_entry.link;
        End;
      text_ptr->text_list_entry.link = null;
      text_ptr->text_list_entry.length = ext_length;
      text_ptr->text_list_entry.text = text;
      Call End_Critical_Section;
      End;
    Else If count = (maxtext+1) Then
      Put Skip List('?Too many lines in one message.  Some lines lost.');
    End Addtext;

  End ReadText;

/* read names from the user and build a sorted tree */
readtree: Procedure (prompt,root,name_count,type);

  Declare prompt Character(*),		/* Prompt string */
	  root Pointer,			/* tree root */
	  name_count Fixed Binary(15),	/* number of names in tree */
	  type Fixed Binary(7);		/* 0 for usernames,
					   1 for terminals */

  Declare Null Builtin;

  Declare name character(63) Varying,
	  input_buffer character(255) Varying,
	  item_count Fixed Binary,
	  (eof_text,text_open,open_error,done) bit(1),
	  textfile File Input Stream,
	  (loc,commaloc) Fixed Binary;

  %Include Read_Line;

  %Include Critical_Section;

  %Include Set_Ctrlc;

  %Include Upper_case;

  /* Start off with empty tree */
  root = null;
  item_count = 0;
  done = '0'b;
  text_open = '0'b;
  name_count = 0;
  On VaxCondition(C_interrupt) GoTo Abort;

  /* Read names from the user and add to sorted tree */
  Do While (^done);

    /* Read line from user and convert to upper case */
    If read_line(prompt,input_buffer,cvt2upper) Then Do;

      /* *ALL on first line means send message to all */
      If item_count ^= 0 | input_buffer ^= '*ALL' Then Do;

        /* Process each name in the input buffer */
        loc = 1;
	If Length(input_buffer) = 0 Then done = '1'b;
        Do While (loc <= Length(Input_buffer) & ^done);

	  /* names are separated by commas */
	  commaloc = Index(Substr(input_buffer,loc),',');
	  If commaloc = 0 Then commaloc = Length(Substr(input_buffer,loc))+1;
	  name = Substr(input_buffer,loc,commaloc-1);

	  /* ! terminates processing */
	  If name = '!' Then done = '1'b;
	  Else Do;
	    item_count = item_count + 1;

	    /* Is this a file reference? */
	    If substr(name,1,1) = '@' Then Do;
	      open_error = '0'b;
	      On Endfile(textfile) eof_text = '1'b;
	      On UndefinedFile(textfile) open_error = '1'b;
	      Call start_critical_section;	
	      Open File(textfile) Title(Substr(name,2));
	      If open_error Then Do;
		Call End_Critical_Section;
		put skip Edit(Substr(name,2),' cannot be opened') (A,A);
		item_count = 2;
		End;
	      Else Do;
		text_open = '1'b;
		Call End_Critical_Section;

		/* Process file */
		eof_text = '0'b;
		Get File(textfile) List(name);
		Do While (^eof_text);
		  name = Upper_Case((name));
		  Call addname(name);
		  Get File(textfile) List(name);
		  End;
		Call Start_Critical_Section;
		text_open = '0'b;
		Close File(textfile);
		Call End_Critical_Section;
		End;
	      End;  /* Process file */
	    Else Call addname(name);
	    loc= loc + commaloc;
	    End;  /* Else */
	  End;  /* Do While */
        End;  /* Not *ALL */
      End;  /* Not Eof(Sysin) */
    Else done = '1'b;
    If item_count <= 1 Then done = '1'b;
    End; /* While ^done */
  Return;

abort:
  If text_open Then Close File(textfile);
  Revert VaxCondition(C_interrupt);
  Signal VaxCondition(C_interrupt);
  Return;

  addname: Procedure(name);

    Declare name Character(*) Varying,
	    term_name Character(7) Varying;

    %Include Sys$Getdev;

    %Include $stsdef;

    Declare pribuf Character(12),
	    Pribufbyte(12) Fixed Binary(7) Based(Addr(pribuf));

    %Replace DC$_term By 66;
	    

    /* Validate name */
    If type = 0 Then Do;
      If Verify(name,'ABCEDFGHIJKLMNOPQRSTUVWXYZ01234567890') ^= 0 |
	 Verify(Substr(name,1,1),'ABCDEFGHIJKLMNOPQRSTUVWXYZ') ^= 0 |
	 Length(name) > 12 Then Do;
        Put Skip Edit('''',Name,''' is an illegal username') (A,A,A);
	Item_count = 2;		/* Force another prompt */
        Return;
        End;
      Else Call tree_insert(name,root);
      End;
    Else Do;
      term_name = name;
      If Substr(term_name,1,1) = '_' Then term_name = Substr(term_name,2);
      If Substr(term_name,Length(term_name),1) = ':' Then
	term_name = Substr(term_name,1,Length(term_name)-1);
      Sts$Value = sys$getdev('_'||term_name||':',,Descriptor(pribuf),,);
      If Sts$Success Then Sts$Success = (Pribufbyte(5) = DC$_Term);
      If ^Sts$Success Then Do;
        Put Skip Edit('''',Name,''' is an illegal terminal name') (A,A,A);
	Item_count = 2;		/* Force another prompt */
        Return;
        End;
      Else Call tree_insert(term_name,root);
      End;
    Return;

    Tree_Insert: Procedure (name,tree);

      Declare name Character(*) Varying,
	      tree Pointer;

      %Include treedef;

      /* Add a node to the sorted tree 'tree' with value 'name' */
      If tree = Null Then Do;
        Call Start_Critical_Section;
	Allocate nametree Set(tree);
	tree->nametree.left = Null;
	tree->nametree.right = Null;
        Call End_Critical_Section;
	tree->nametree.name = name;
	name_count = name_count + 1;
	End;
      Else If name = tree->nametree.name Then
	Put Skip Edit('''',name,''' is a duplicate entry') (A,A,A);
      Else If name < tree->nametree.name Then
	Call Tree_insert(name,tree->nametree.left);
      Else Call Tree_insert(name,tree->nametree.right);
      End Tree_insert;

    End addname;

  End readtree;

Write_list: Procedure (namelist,title,line_count);

  Declare namelist(*) Character(*),
	  title Character(*),
	  line_count Fixed Binary(31);

  Declare buffer Character(80) Varying,
	  i Fixed Binary,
	  name Character(13) Varying;

  %Include Write_Request;

  Buffer = title;
  Do i = 1 To Hbound(namelist,1);
    name = namelist(i) || ' ';
    name = Substr(name,1,Index(name,' ')-1) || ',';
    If (length(name) + length(buffer)) > 77 Then Do;
      Call Write_Request(1,line_count);
      Put Skip Edit(buffer) (Column(4),A);
      buffer = Copy(' ',Length(title));
      End;
    buffer = buffer || name;
    End;
  If Length(buffer) > Length(title) Then Do;
    Call Write_Request(1,line_count);
    Put Skip Edit(Substr(buffer,1,Length(Buffer)-1)) (Column(4),A);
    End;
  End write_list;