{$M-}
program iomsg;

include {NOLIST} 'domain:jsys.def';
include {NOLIST} 'pascal:extern.pas';
include {NOLIST} 'domain:mdep.def';
include {NOLIST} 'domain:master.def';
include {NOLIST} 'domain:udp.def';
include {NOLIST} 'domain:lparse.def';
include {NOLIST} 'domain:mdep.hdr';
include {NOLIST} 'domain:msub.hdr';

{ **********************************************************

 This program contains procedures for managing the three
 types of messages generated by the server.

     FATAL - terminal illness
     ERROR - recoverable errors
     LOG   - logging information

 An array of file_blks which contain lock and actual
 file ident are kept in the master block.

 There are three procedures associated with file operations.
 The O procedure prepares the file for output (open and/or
 locking.)  The H procedure outputs a date time, etc header.
 The C procedure closes the file.  NOTE:  locking mechanisms
 are not in place!     

 Also included here is the procedure jsys_err which handles
 printing of jsys error messages and termination of program
 execution if dictated by the calling party.

********************************************************** }

var	master:master_block_pointer;
	myblk:file_blk;



procedure pheader(    ftype:file_type;
		  var fp:file_blk_ptr );

{ Print timestamp and Domain leader to identify
  subsequent message. }

begin  { pheader }
    tstamp(fp^.fident);
    case ftype of
	fatl:  write(fp^.fident, ' DOMAIN:F: ');
	err:   write(fp^.fident, ' DOMAIN:E: ');
	log:   write(fp^.fident, ' DOMAIN:L: ');
    end;
end; { pheader }


function ofile( ftype:file_type ):file_blk_ptr;

{ Based on the file type, either enable writing to the tty,
  create a new file, or allow appending to an existing one.
  If create or append fails, default to the tty.  It also is
  the case that calling procedures without access to the master
  block will always write to the tty also. }

var	fbp:file_blk_ptr;

begin  { ofile }
    master:=getmaster;
    if master = NIL
    then begin  {calling procedure has no access to master block}
	     rewrite(myblk.fident, 'TTY:' );
	     {obtain file_blk ptr value}
	     fbp:=fbptr(myblk);
	 end
    else begin
	     while not locke(master^.msg_files[ftype].flock,200,30000)
	     do;
	     case ftype of
		 fatl: rewrite(master^.msg_files[ftype].fident, 'TTY:');
		 err:  append(master^.msg_files[ftype].fident,
			      'domain:domain.error', '/O');
		 log:  append(master^.msg_files[ftype].fident,
			      'domain:domain.log', '/O');
	     end;

	     if erstat(master^.msg_files[ftype].fident) <> 0
	     then begin  {file didn't exist}
		      clreof(master^.msg_files[ftype].fident);
		      case ftype of 
			  fatl: quit;  {in trouble here}
			  err:  rewrite(master^.msg_files[ftype].fident,
					'domain:domain.error', '/O');
			  log:  rewrite(master^.msg_files[ftype].fident,
					'domain:domain.log', '/O');
		      end;
		      if erstat(master^.msg_files[ftype].fident) <> 0
		      then rewrite(master^.msg_files[ftype].fident, 'TTY:');
		  end;
	     {obtain file_blk ptr value}
	     fbp:=fbptr(master^.msg_files[ftype]);
	 end;
    
    pheader(ftype, fbp);  {print leading information}
    ofile:=fbp;

end; { ofile }


procedure cfile( var fp:file_blk_ptr );

begin  { cfile }
    close(fp^.fident);
    if getmaster<>NIL then ulocke(fp^.flock)
end; { cfile }


procedure jsys_err( halt:boolean;
		    error_code:integer;
		    myfbp:file_blk_ptr );

{ Output the error message for the given error code which
  resulted from a jsys call.  If the error code is -1,
  then the most recent error message is printed. }

var   	i:integer;
	error_str:packed array [1..80] of char;

begin  { jsys_err }
    
    {convert code to text string}
    jsys(erstr, 2; error_str, fhslf:error_code, 0); 

    {Output error message--terminate on null.
     Assume that file to write to is already open.}
    i:=1;
    while (error_str[i]<>chr(0)) and (i<81) do
    begin
	write(myfbp^.fident, error_str[i]);
	i:=i+1;
    end; 
    writeln(myfbp^.fident);

    if halt 
    then begin
	     cfile(myfbp);
	     quit;
	 end;

end. { jsys_err }