{ ROSSYM.INC - Remote Operating System Sysop Sub-system, Miscellaneous routines } overlay procedure toggle_printer; { Turn printer on and off } begin if printer_copy then printer_copy := FALSE else printer_copy := ask('Turn on printer'); write(USR, 'Printer o'); if printer_copy then writeln(USR, 'n.') else writeln(USR, 'ff.') end; overlay procedure process_newin; { Process and update newin file (add, delete, edit, hide, and release) } var ch, ch_sel: char; i, TmpDrv, TmpUsr: integer; str: StrTAD; ed_descr: StrStd; temp_user_rec: user_list; begin FindSect('NEWIN', TmpDrv, TmpUsr, OK); if OK then i := pred(FileSize(nwin_file)) else writeln(USR, 'NEWIN section not found.'); while OK and (i >= 0) do with nwin_rec do begin seek(nwin_file, i); read(nwin_file, nwin_rec); GetRec(DatF, user, temp_user_rec); writeln(USR); case status of private: write(USR, 'Hidden '); public: write(USR, 'Released '); deleted: write(USR, 'Deleted ') end; writeln(USR, pad(name, 15), descr); str := FormTAD(date); writeln(USR, ' ', pad(str, 30), temp_user_rec.fn, ' ', temp_user_rec.ln); writeln(USR); ch_sel := select('Newin command', 'AddDeleteEditHideReleaseQuit'); case ch_sel of 'A': begin name := correct_fn(prompt('File name', 12, 'ES')); if name <> '' then begin while (length(name) - pos('.', name)) < 2 do name := name + '-'; writeln(USR, ' |-------- File description ----------------------|'); descr := prompt('', 50, 'E'); GetTAD(date); user := user_loc; i := FileSize(nwin_file); status := public end end; 'D': status := deleted; 'E': begin writeln(USR); writeln(USR, '|-------- File description ----------------------|'); ed_descr := descr; GetStr(ed_descr, ch, 50, 'E'); descr := ed_descr; writeln(USR) end; 'H': status := private; 'R': status := public; 'Q': i := 0; '?': writeln(USR, 'dd, elete, dit, ide, elease, uit') end; if ch_sel in ['A', 'D', 'H', 'R'] then begin SetSect(TmpDrv, TmpUsr); hide_release(name, status); SetSect(HomDrv, HomUsr) end; if ch_sel in ['A', 'D', 'E', 'H', 'R'] then begin seek(nwin_file, i); write(nwin_file, nwin_rec) end; if ch_sel <> '?' then i := pred(i) end end; overlay procedure print_log; { Print the log file } const txt_act: array[0..9] of FileName = ('ROS up ', 'ROS down ', 'Login ', 'Logout ', 'Recv-Xmdm', 'Send-Xmdm', 'Send-Text', 'Complete ', 'Failed ', 'New User '); var t: tad_array; str: StrTAD; cur_date: real; temp_user_rec: user_list; begin str := prompt('Date to start listing [dd mm yy]', 8, 'E'); GetTAD(t); if length(str) >= 2 then t[3] := strint(copy(str, 1, 2)); if length(str) >= 5 then t[4] := strint(copy(str, 4, 2)); if length(str) >= 8 then t[5] := strint(copy(str, 7, 2)); cur_date := greg_to_jul(t[3], t[4], t[5]); GetTAD(t); str := FormTAD(t); writeln(USR, FF, 'Log file as of: ', str); writeln(USR); if audit_on then begin writeln(AuditFile, FF, 'Log file as of: ', str); writeln(AuditFile) end; seek(logr_file, 1); {$I-} read(logr_file, logr_rec) {$I+}; if IOresult = 0 then with logr_rec do begin while not (brk or EOF(logr_file) or (greg_to_jul(date[3], date[4], date[5]) >= cur_date)) do read(logr_file, logr_rec); while not (brk or EOF(logr_file)) do begin if action > 1 then GetRec(DatF, logr_rec.user, temp_user_rec) else begin temp_user_rec.fn := ''; temp_user_rec.ln := '' end; str := FormTAD(date); writeln(USR, pad(str, 28), txt_act[action], ' ', pad(temp_user_rec.fn + ' ' + temp_user_rec.ln, succ(len_name)), text); if audit_on then writeln(AuditFile, pad(str, 28), txt_act[action], ' ', pad(temp_user_rec.fn + ' ' + temp_user_rec.ln, succ(len_name)), text); read(logr_file, logr_rec) end end end; overlay procedure print_messages; { Print the message file } var i, j, first_line, last_line: integer; cur_date: real; t: tad_array; str: StrTAD; begin str := prompt('Date to start listing [dd mm yy]', 8, 'E'); GetTAD(t); if length(str) >= 2 then t[3] := strint(copy(str, 1, 2)); if length(str) >= 5 then t[4] := strint(copy(str, 4, 2)); if length(str) >= 8 then t[5] := strint(copy(str, 7, 2)); cur_date := greg_to_jul(t[3], t[4], t[5]); GetTAD(t); str := FormTAD(t); writeln(USR, FF, 'Message file as of: ', str); if audit_on then writeln(AuditFile, FF, 'Message file as of: ', str); i := 1; seek(summ_file, i); {$I-} read(summ_file, summ_rec) {$I+}; if IOresult = 0 then begin while not (brk or EOF(summ_file) or (greg_to_jul(summ_rec.date[3], summ_rec.date[4], summ_rec.date[5]) >= cur_date)) do begin read(summ_file, summ_rec); i := succ(i) end; i := pred(i); while not (brk or EOF(summ_file)) do begin writeln(USR); if audit_on then writeln(AuditFile); mesg_header_list(i, first_line, last_line); seek(mesg_file, first_line); for j := 1 to last_line do begin read(mesg_file, mesg_rec); writeln(USR, mesg_rec); if audit_on then writeln(AuditFile, mesg_rec) end; i := succ(i) end end end; overlay procedure process_macro; { Process sysop macro } var done: boolean; ed_macro: StrStd; begin done := FALSE; repeat writeln(USR); case select('Macro command', 'DisplayEditStartQuit') of 'D': writeln(USR, macro); 'E': begin ed_macro := macro; GetStr(ed_macro, ch, 50, 'ES'); writeln(USR); macro := ed_macro end; 'S': begin macro_ptr := 1; done := TRUE end; 'Q': done := TRUE; '?': writeln(USR, 'isplay, dit, tart, uit') end until done end; overlay procedure sys_dir; { Create system directory file } var TmpDrv, TmpUsr, KepDrv, KepUsr: integer; this: SectPtr; t: tad_array; KepReq: Str10; str: StrTAD; dir_file: text; procedure center(str: StrStd); { Center string on print line } begin writeln(dir_file, ' ':((user_rec.columns - length(str)) div 2), str); writeln(dir_file) end; procedure write_dir; { Write directory to file } const col_width = 19; var i, j, k, entries, rows, size, col_limit: integer; this: FilePtr; nodes: array[1..4] of FilePtr; str: Str10; begin col_limit := max(1, user_rec.columns div col_width); writeln(dir_file); entries := DirEntries; if entries <> 0 then begin this := DirBase; writeln(dir_file, ' File area: ', SectReq, ' Files: ', entries, ' Space used: ', DirSpace, 'k'); rows := entries div col_limit; if 0 <> entries mod col_limit then rows := succ(rows); nodes[1] := this; for i := 2 to col_limit do begin for j := 1 to rows do this := this^.next; nodes[i] := this end; i := 1; while not (brk or (i > rows)) do begin for j := 1 to col_limit do begin this := nodes[j]; if (i + rows * pred(j)) <= entries then begin size := this^.fsize shr 3; if (this^.fsize mod 8) <> 0 then size := succ(size); str := intstr(size, 4) + 'k '; write(dir_file, this^.fname, str); if j < col_limit then write(dir_file, fence, ' ') else writeln(dir_file) end else writeln(dir_file); nodes[j] := nodes[j]^.next { Go to next on list } end; i := succ(i) end end; if j <> col_limit then writeln(dir_file) end; begin { sys_dir } write(USR, 'Building system directory...'); KepDrv := SetDrv; KepUsr := SetUsr; KepReq := SectReq; FindSect('LOGIN', TmpDrv, TmpUsr, OK); if not OK then begin TmpDrv := HomDrv; TmpUsr := HomUsr end; SetSect(TmpDrv, TmpUsr); Assign(dir_file, 'SYSTEM.DIR'); {$I-} Rewrite(dir_file) {$I+}; OK := (IOresult = 0); if OK then begin center('Complete System Directory Listing'); center('as of'); GetTAD(t); str := FormTAD(t); center(str); this := SectBase; while this <> nil do begin if this^.SectAccs <= val_acc then begin SectReq := this^.SectName; SetDrv := this^.SectDrive; SetUsr := this^.SectUser; SetSect(HomDrv, HomUsr); ReadDir(DirEntries, DirSpace, DirBase); SetSect(TmpDrv, TmpUsr); write_dir end; this := this^.next end; Close(dir_file); SetSect(Homdrv, HomUsr); SectReq := KepReq; SetDrv := KepDrv; SetUsr := KepUsr; ReadDir(DirEntries, DirSpace, DirBase) end; writeln(USR) end; overlay procedure toggle_audit; { Turn the audit trail on and off } var i, ext: integer; t: tad_array; AuditName: FileName; begin if audit_on then begin Close(AuditFile); writeln(USR, 'Audit file closed.'); audit_on := FALSE end else begin GetTAD(t); ext := 0; repeat AuditName := intstr(t[4], 2) + '-' + intstr(t[3], 2) + '-' + intstr(t[5], 2) + '.' + intstr(ext, 3); for i:= 1 to length(AuditName) do if AuditName[i] = ' ' then AuditName[i]:= '0'; Assign(AuditFile, AuditName); {$I-} Reset(AuditFile) {$I+}; { Make sure it's a new file } ext := succ(ext) until IOresult <> 0; Rewrite(AuditFile); writeln(USR, 'Audit file, ', AuditName, ', ready.'); audit_on := TRUE end end;