daily_log_process.pl1 01/16/85 1233.0rew 01/16/85 1229.4 175365 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4 */ daily_log_process: proc; /* This program is run once a day to process the log for the preceding day. It writes out all log entries on various streams. USAGE: . daily_log_process -logname- -(-from date)- If the "-from date" option is not given, the program looks for "sys_admin_data" in the current working directory, and uses the "log_control" structure there to look for a note which says how far daily_log_process got last time. It continues from there. Otherwise, the log is scanned for a line beginning with "date" and we go from there. Distribution of the output is controlled by the control file, "log_select_file", in the current working directory. This file has comment lines beginning with "*", and lines of the form . streamname,S,opcode,text streamname is the name of the stream on which a line will be written. S is the minimum severity which will be considered. opcode is the operation code (see below) text is optional text which is the operand of opcode. Legal opcodes are: . all selects all lines at this severity . any selects all lines containing text . begin selects all lines beginning text . not inhibits all lines containing text . nbegin inhibits all lines beginning text . count counts all lines containing text . bcount counts all lines beginning text . usage accumulates totals for network lines . charge accumulates charges for network lines "not" and "nbegin" must precede any selectors they are to inhibit, for a given stream. ALL STREAMS MUST BE PRE-ATTACHED. At the end of processing, total lines are written. Then, if any lines were selected, a total count is output. THVV */ /* Modified October, 1980 by J. N. R. Barnecut to allow 15 extra logs rather than 5. */ /* Modified September, 1982 by E. N. Kittlitz to increase number of streams, selectors, and check array bounds */ dcl path char (168) init (">system_control_dir>log"); dcl dn char (168); dcl en char (32); dcl c32 char (32); dcl p ptr; dcl sadp ptr; dcl logx fixed bin; dcl bcs char (131071) based (p); dcl buffer char (120); dcl ec fixed bin (35); dcl bchr char (al) based (ap); dcl testsw bit (1) aligned init ("0"b); dcl ap ptr; dcl al fixed bin (21); dcl sys_log_ptr ptr; dcl timestr char (16); dcl opword char (8); dcl (i, j, k, l, m, n) fixed bin; dcl vcs char (64) varying; dcl c1 char (1) aligned; dcl max_test fixed bin; dcl nstreams fixed bin init (0); dcl nwrote fixed bin init (0); dcl nscan fixed bin init (0); dcl xj fixed bin; dcl icount fixed bin (24); dcl pl fixed bin init (23); dcl an fixed bin init (1); /* declarations for "usage" and "charge", "extra_log", and "-from" logic EWM 103072 */ dcl extra_log_index fixed bin init (0); /* how many extra levels of logs are there ? */ dcl extra_log_ptrs (15) ptr; /* ptrs to up to 15 extra logs */ dcl (charge_count, charge_seconds, usage_count, usage_seconds, usage_dempages, usage_prepages) fixed bin init (0); dcl (curidx, incr, len) fixed bin; dcl (minutes, seconds, dempages, prepages) fixed bin (35); dcl limit_sw bit (1) init (""b); /* =1 if "-from" option is used */ dcl limit_time fixed bin (71); /* = earliest time for retrieval if "-from" option is used */ dcl linep ptr; dcl dec_string char (12) var; dcl 1 based_line aligned based (linep), 2 part1 char (curidx - 1) unaligned, 2 part2 char (117 - curidx) unaligned; dcl NL char (1) aligned int static init (" "); dcl 1 temp_str (500) aligned, 2 cs char (64) unal, 2 opcode fixed bin, 2 tot fixed bin, 2 streamno fixed bin, 2 tsvty fixed bin, 2 tlth fixed bin; dcl 1 streams (50) aligned, 2 stream char (32) unal, 2 odate char (8), 2 inhib fixed bin, 2 lastline fixed bin, 2 linecount fixed bin; dcl format char (14) aligned int static init ("^4d ^16a ^d ^a"); dcl (addr, null, hbound, index, length, max, mod, divide, substr) builtin; dcl cleanup condition; dcl convert_binary_integer_$decimal_string entry (fixed bin (35), char (12) var); dcl convert_date_to_binary_ entry (char (*), fixed bin (71), fixed bin (35)); dcl get_wdir_ entry () returns (char (168)); dcl initiate_file_ entry (char (*), char (*), bit (*), ptr, fixed bin (24), fixed bin (35)); dcl terminate_file_ entry (ptr, fixed bin (24), bit (*), fixed bin (35)); dcl com_err_ entry options (variable); dcl date_time_ entry (fixed bin (71), char (*)); dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)); dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)); dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); dcl ioa_ entry () options (variable); dcl ioa_$ioa_stream entry () options (variable); /* ======================================================= */ /* Internal procedure to write a line on a stream if not there already. */ wout: proc (sx, lx); dcl (sx, lx) fixed bin; dcl tdate char (16) aligned; if lastline (sx) = lx then return; if inhib (sx) = lx then return; tdate = timestr; if substr (timestr, 1, 8) = odate (sx) then substr (tdate, 1, 8) = ""; else odate (sx) = tdate; call ioa_$ioa_stream (stream (sx), format, lx, tdate, sys_log_file.svty (lx), sys_log_file.line (lx)); lastline (sx) = lx; nwrote = nwrote + 1; linecount (sx) = linecount (sx) + 1; end wout; /* ------------------------------------------------------- */ /* First read in control file */ p, sadp, sys_log_ptr = null; on cleanup call clean_up; call initiate_file_ (get_wdir_ (), "log_select_file", R_ACCESS, p, icount, ec); if p = null then do; call com_err_ (ec, "daily_log_process", "control file missing - log_select_file"); return; end; icount = divide (icount, 9, 17, 0); j = 1; do k = 1 repeat i + k while (k < icount); i = index (substr (bcs, k), NL); buffer = substr (bcs, k, i - 1); if substr (buffer, 1, 1) = "*" then go to incrs; m = index (buffer, ","); c32 = substr (buffer, 1, m - 1); do l = 1 to nstreams; if c32 = stream (l) then go to fstr; end; if nstreams >= hbound (streams, 1) then do; call com_err_ (0, "daily_log_process", "The limit of ^d streams has been exceeded.", hbound (streams, 1)); go to punt; end; l, nstreams = nstreams + 1; linecount (l), inhib (l), lastline (l) = 0; stream (l) = c32; odate (l) = ""; fstr: streamno (j) = l; c1 = substr (buffer, m + 1, 1); if c1 = "2" then tsvty (j) = 2; else if c1 = "1" then tsvty (j) = 1; else tsvty (j) = 0; buffer = substr (buffer, m + 3); n = index (buffer, ","); if n = 0 then n = i - m - 2; opword = substr (buffer, 1, n - 1); if opword = "all" then opcode (j) = 1; else if opword = "any" then opcode (j) = 2; else if opword = "begin" then opcode (j) = 3; else if opword = "not" then opcode (j) = 4; else if opword = "nbegin" then opcode (j) = 5; else if opword = "count" then opcode (j) = 6; else if opword = "bcount" then opcode (j) = 7; else if opword = "usage" then opcode (j) = 8; else if opword = "charge" then opcode (j) = 9; else do; call com_err_ (0, "daily_log_process", "Illegal opcode ^a", opword); go to incrs; end; tot (j) = 0; cs (j) = substr (buffer, n + 1); tlth (j) = i - m - 3 - n; if j >= hbound (temp_str, 1) then do; call com_err_ (0, "daily_log_process", "The limit of ^d selectors has been exceeded.", hbound (temp_str, 1)); go to punt; end; j = j + 1; incrs: end; max_test = j - 1; call ioa_ ("daily_log_process: ^d streams, ^d selectors", nstreams, max_test); if max_test = 0 then return; /* process arguments */ an = 1; j = 0; /* switch for dispatching on "-from" code */ arglp: call cu_$arg_ptr (an, ap, al, ec); if ec ^= 0 then go to endarg; if j = 1 then do; /* process limit argument following "-from" */ j = 0; limit_sw = "1"b; call convert_date_to_binary_ (bchr, limit_time, ec); if ec ^= 0 then goto badarg; end; else if bchr = "-from" then j = 1; else do; path = bchr; pl = al; end; nxtarg: an = an + 1; go to arglp; endarg: call expand_pathname_ (path, dn, en, ec); if ec ^= 0 then do; er: call com_err_ (ec, "daily_log_process", path); return; end; if ^limit_sw then do; call initiate_file_ (get_wdir_ (), "sys_admin_data", R_ACCESS, sadp, (0), ec); if sadp = null then go to er; do logx = 1 to sys_admin_data.n_logs; if sys_admin_data.log_id (logx) = en then do; go to initiate_logs; end; end; end; initiate_logs: call initiate_file_ (dn, en, R_ACCESS, sys_log_ptr, (0), ec); if sys_log_ptr = null then if extra_log_index = 0 then go to er; /* we didn't find the primary log. Real bad */ else do; /* it's the previous log not found. switch to primary */ call com_err_ (ec, "daily_log_process", "old log ^a not found", en); sys_log_ptr = extra_log_ptrs (extra_log_index); /* restore the previous log */ extra_log_index = extra_log_index - 1; /* Back down to next log */ curidx = 1; /* If we wanted previous log, we want first entry of this log */ go to dolog; end; if extra_log_index = hbound (extra_log_ptrs, 1) then goto find_start_index; /* Limit the search for previous logs */ if ^limit_sw then if logx <= sys_admin_data.n_logs then if log_control.last_entry (logx) ^= 0 then if sys_log_file.time (log_control.last_entry (logx)) = log_control.last_entry_date (logx) then do; curidx = log_control.last_entry (logx); /* pick up where we left off */ go to dolog; end; else ; else ; /* Log point is invalid. */ else ; /* Log name not registered. */ else if sys_log_file.time (1) > limit_time then ; /* "limit_sw" is on, and whole log is after. */ else go to find_start_index; /* .. some of log is before limit. no need secondary. */ if sys_log_file.lls = "" then goto find_start_index; /* no previous log */ if sys_log_file.lls < "" then goto find_start_index; /* no previous log */ initiate_next_log: extra_log_index = extra_log_index + 1; extra_log_ptrs (extra_log_index) = sys_log_ptr; en = "log.-." || sys_log_file.lls; goto initiate_logs; /* to init the previous one */ /* */ /* Following code implements a logarithmic search to find the starting point based upon a lower time bound. Upper bound k is always a permissible starting point except at the start when it is out of bounds. Lower bound j is not necessarily a permissible starting point. We stop when j is out of bounds (failure) or j = k (success) */ find_start_index: if ^limit_sw then do; /* start is based on last entry processed */ curidx = 1; /* But we don't know where to start. */ goto dolog; end; j = 1; /* lower bound for logarithmic search */ k = sys_log_file.count + 1; /* initial upper bound is out of bounds */ get_check_index: curidx = divide (k + j, 2, 17, 0); if sys_log_file.array (curidx).time < limit_time then do; /* This is below lower bound */ j = curidx + 1; if j > sys_log_file.count then if extra_log_index = 0 then goto time_err; /* User specified time not in data base */ else goto finish_log; /* Will process the next log */ end; else k = curidx; /* It's OK, therefore it becomes new upper bound */ if j = k then do; /* We've limited it down */ curidx = j; goto dolog; end; goto get_check_index; /* To do another iteration */ /* */ /* Following code is the processing loop on log entries. Each line is checked against all selectors to see if it should be written. */ dolog: icount = sys_log_file.count; /* Dont do any item twice. */ do i = curidx to icount; nscan = nscan + 1; call date_time_ (sys_log_file.time (i), timestr); do j = 1 to max_test; if sys_log_file.svty (i) < tsvty (j) then go to skiptst; if tlth (j) > 0 then vcs = substr (cs (j), 1, tlth (j)); else vcs = ""; xj = streamno (j); if opcode (j) = 1 then call wout (xj, i); else if opcode (j) = 5 then do; if substr (sys_log_file.line (i), 1, tlth (j)) = vcs then inhib (xj) = i; end; else if opcode (j) = 4 then do; if index (sys_log_file.line (i), vcs) ^= 0 then inhib (xj) = i; end; else if opcode (j) = 2 then do; if index (sys_log_file.line (i), vcs) ^= 0 then call wout (xj, i); end; else if opcode (j) = 3 then do; if substr (sys_log_file.line (i), 1, tlth (j)) = vcs then call wout (xj, i); end; else if opcode (j) = 6 then do; /* count */ if index (sys_log_file.line (i), vcs) ^= 0 then tot (j) = tot (j) + 1; end; else if opcode (j) = 7 then do; /* bcount */ if substr (sys_log_file.line (i), 1, tlth (j)) = vcs then tot (j) = tot (j) + 1; end; else if opcode (j) = 8 then do; /* usage */ if index (sys_log_file.line (i), vcs) ^= 0 then goto DECODE_USAGE_VALS; end; else if opcode (j) = 9 then do; /* charge */ if index (sys_log_file.line (i), vcs) ^= 0 then goto DECODE_CHARGES; end; skiptst: end; endlp: end; finish_log: if ^limit_sw then if logx <= sys_admin_data.n_logs then do; log_control.last_entry (logx) = icount; log_control.last_entry_date (logx) = sys_log_file.time (icount); end; call terminate_file_ (sys_log_ptr, 0, TERM_FILE_TERM, ec); if extra_log_index > 0 then do; sys_log_ptr = extra_log_ptrs (extra_log_index); extra_log_index = extra_log_index - 1; curidx = 1; /* start at first point of next log */ go to dolog; end; if ^limit_sw then call terminate_file_ (sadp, 0, TERM_FILE_TERM, ec); call ioa_ ("daily_log_process: scanned ^d, wrote ^d", nscan, nwrote); do j = 1 to max_test; /* now put out stiff for counters */ if opcode (j) = 6 then do; opword = "matching"; go to ct2; end; else if opcode (j) = 7 then do; opword = "starting"; ct2: xj = streamno (j); if linecount (xj) = 0 then if tot (j) = 0 then go to ct3; call ioa_$ioa_stream (stream (xj), "^/^-^6d lines ^a ""^a""", tot (j), opword, substr (cs (j), 1, tlth (j))); end; else if opcode (j) = 8 then do; /* usage */ if usage_count = 0 then goto ct3; xj = streamno (j); call ioa_$ioa_stream (stream (xj), "^/^6d lines ""^a"", total cpusec = ^d^/average usage per line: cpusec = ^d, pages = ^d+^d", usage_count, substr (cs (j), 1, tlth (j)), usage_seconds, divide (usage_seconds, usage_count, 17, 0), divide (usage_prepages, usage_count, 17, 0), divide (usage_dempages, usage_count, 17, 0)); end; else if opcode (j) = 9 then do; /* charge */ if charge_count = 0 then goto ct3; xj = streamno (j); seconds = divide (charge_seconds, charge_count, 17, 0); call ioa_$ioa_stream (stream (xj), "^/^6d lines ""^a"", total charged cpusec = ^d^/average charge per line = ^d:^2d", charge_count, substr (cs (j), 1, tlth (j)), charge_seconds, divide (seconds, 60, 17, 0), mod (seconds, 60)); if usage_count = 0 then goto ct3; seconds = divide (charge_seconds * 100, usage_seconds, 17, 0); /* get ratio x 100 */ call convert_binary_integer_$decimal_string (seconds, dec_string); len = length (dec_string); if len < 2 then do; dec_string = " " || dec_string; len = len + 2; end; call ioa_$ioa_stream (stream (xj), "^/(charge cpu seconds)/(usage cpu seconds) ratio = ^a.^a", substr (dec_string, 1, len - 2) /* integer part */, substr (dec_string, len - 1, 2) /* fraction part */); end; ct3: end; do xj = 1 to nstreams; /* now put out line totals */ if linecount (xj) > 0 then call ioa_$ioa_stream (stream (xj), "^/Total of ^d lines", linecount (xj)); end; punt: call clean_up; return; badarg: call com_err_ (ec, "daily_log_process", "Bad argument ^a", bchr); return; time_err: call com_err_ (0, "daily_log_process", "Time specified later than within logs"); return; /* */ /* CODE TO PROCESS "usage" and "charge" orders follows */ DECODE_USAGE_VALS: linep = addr (sys_log_file.line (i)); len, incr = 0; decode_useconds: curidx = index (sys_log_file.line (i), "=") + 1; if curidx < 2 then goto line_format_error; len = index (based_line.part2, ",") - 1; if len < 1 then goto line_format_error; seconds = cv_dec_check_ (substr (sys_log_file.line (i), curidx, len), ec); if ec ^= 0 then goto conversion_error; decode_prepages: incr = index (based_line.part2, "=") + 1; if incr < 2 then goto line_format_error; curidx = curidx + incr; len = index (based_line.part2, "+") - 1; if len < 1 then goto line_format_error; prepages = cv_dec_check_ (substr (sys_log_file.line (i), curidx, len), ec); if ec ^= 0 then goto conversion_error; decode_dempages: curidx = curidx + len + 1; dempages = cv_dec_check_ ((based_line.part2), ec); if ec ^= 0 then goto conversion_error; update_usage_totals: usage_count = usage_count + 1; usage_seconds = usage_seconds + seconds; usage_prepages = usage_prepages + prepages; usage_dempages = usage_dempages + dempages; goto skiptst; /* to process the next line */ DECODE_CHARGES: linep = addr (sys_log_file.line (i)); len, incr = 0; decode_minutes: curidx = index (sys_log_file.line (i), ":") - 1; if curidx < 2 then goto line_format_error; do incr = curidx to 1 by -1; if substr (sys_log_file.line (i), incr, 1) = " " then goto decode_minutes1; end; goto line_format_error; /* we never found the beginning */ decode_minutes1: len = curidx - incr; minutes = cv_dec_check_ (substr (sys_log_file.line (i), incr + 1, len), ec); if ec ^= 0 then goto conversion_error; decode_cseconds: curidx = curidx + 2; len = 2; /* seconds field has two digits */ seconds = cv_dec_check_ (substr (sys_log_file.line (i), curidx, len), ec); if ec ^= 0 then goto conversion_error; update_charge_totals: charge_count = charge_count + 1; charge_seconds = charge_seconds + minutes * 60 + seconds; goto skiptst; /* to process the next line */ conversion_error: call com_err_ (0, "daily_log_process", "conversion_error in char ^d of: ""^a""", ec, substr (sys_log_file.line (i), curidx, len)); line_format_error: call com_err_ (0, "daily_log_process", "format_error in line ^d. Line = ^/^a^/curidx = ^d, len = ^d, incr = ^d", i, sys_log_file.line (i), curidx, len, incr); goto skiptst; /* to process the next line */ clean_up: proc; if sys_log_ptr ^= null then call terminate_file_ (sys_log_ptr, 0, TERM_FILE_TERM, (0)); if p ^= null then call terminate_file_ (p, 0, TERM_FILE_TERM, (0)); if sadp ^= null then call terminate_file_ (sadp, 0, TERM_FILE_TERM, (0)); end; %page; %include access_mode_values; %page; %include syslog; %page; %include sys_admin_data; %page; %include terminate_file; end daily_log_process;  monitor_log.pl1 01/16/85 1233.0rew 01/16/85 1229.9 223866 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* monitor_log.pl1 -- program to monitor and print on the users terminal doings in a standard system log */ /* format: style2 */ monitor_log: procedure options (variable); /* Various times in 1981, Benson I. Margulies */ /* honi soit qui mal y pense */ /* faults and such fixed BIM 11/82 */ %include syslog; %page; %include monitor_log_info_; declare cv_dec_check_ entry (character (*), fixed bin (35)) returns (fixed bin (35)); declare continue_to_signal_ entry (fixed binary (35)); declare convert_ipc_code_ entry (fixed bin (35)); declare com_err_ entry options (variable); declare cu_$arg_count entry (fixed bin, fixed bin (35)); declare cu_$arg_ptr entry (fixed bin, pointer, fixed bin (21), fixed bin (35)); declare cu_$cp entry (pointer, fixed bin (21), fixed bin (35)); declare expand_pathname_ entry (character (*), character (*), character (*), fixed bin (35)); declare (get_temp_segment_, release_temp_segment_) entry (character (*), pointer, fixed bin (35)); declare ( hcs_$set_ips_mask, hcs_$reset_ips_mask ) entry (bit (36) aligned, bit (36) aligned); declare ioa_ entry options (variable); declare monitor_log_util_$wakeup_handler entry; declare monitor_log_util_$initiate_path entry (char (*), char (*), char (*), ptr, fixed bin (35)); declare monitor_log_util_$initiate_log entry (ptr, fixed bin (35)); declare monitor_log_util_$check_log_switch entry (pointer) returns (bit (2) aligned); declare requote_string_ entry (char (*)) returns (char (*)); declare term_$single_refname entry (char (*), fixed bin (35)); declare timer_manager_$alarm_call entry (fixed bin (71), bit (2), entry); declare timer_manager_$reset_alarm_call entry (entry); declare unique_chars_ entry (bit (*)) returns (char (15)); declare nargs fixed bin; declare old_logp pointer; declare emtp pointer; declare sys_log_ptr pointer; declare severity fixed binary; declare 1 toggles aligned, 2 action_options aligned, 3 (have_print, have_off, have_time, have_match, have_exclude, remove_match, remove_exclude, have_call, have_severity, have_no_severity) bit (1) unaligned, 3 pad bit (24) unaligned, 2 state_flags aligned, 3 (have_log, all_logs, have_this_log, match, have_numbered_log, have_path) bit (1) unaligned, 3 pad bit (30) unaligned; declare log_number fixed bin; declare saved_ips_mask bit (36) aligned; declare time fixed bin (71); declare log_d character (168); declare log_e character (32); declare command character (512) aligned; declare current_argument fixed bin; declare ap pointer, al fixed bin (21), argument character (al) based (ap); declare i fixed bin; declare 1 em aligned based (emtp), 2 current fixed bin, 2 matches fixed bin, 2 excludes fixed bin, 2 entries (1024) aligned, 3 match bit (1), 3 string character (128) varying; declare ( error_table_$namedup, error_table_$segknown, error_table_$noentry, error_table_$noarg, error_table_$badopt, error_table_$name_not_found, error_table_$bad_conversion, error_table_$inconsistent, error_table_$too_many_args, error_table_$too_many_names, error_table_$action_not_performed ) ext static fixed bin (35); declare code fixed bin (35); declare any_other condition; declare cleanup condition; declare fixedoverflow condition; declare ME character (11) init ("monitor_log") int static options (constant); declare (codeptr, substr, null, length, string, index, search, after, before, rtrim) builtin; emtp = null (); call cu_$arg_count (nargs, code); if code ^= 0 then do; /* we dont make a very useful af */ call com_err_ (code, ME); return; end; if nargs = 0 then do; call com_err_ (0, ME, "Usage: monitor_log {log_path} -control_args"); return; end; emtp = null (); current_argument = 0; string (toggles) = ""b; /* clear state and options */ do while (current_argument < nargs); call get_next_argument; if index (argument, "-") ^= 1 then do; /* noncontrol argument ==> must be logname */ if have_log then do; two_logs: call com_err_ (error_table_$too_many_names, ME, "^[Only one log name may be given.^;A log name may not be given with -all.^]", ^all_logs); goto RETURN; end; call expand_pathname_ (argument, log_d, log_e, code); if code ^= 0 then do; call com_err_ (code, ME, "^a.", argument); goto RETURN; end; have_log = "1"b; have_path = (search (argument, "<>") ^= 0); end; else if argument = "-number" | argument = "-nb" then do; if have_log then goto two_logs; have_log, have_numbered_log = "1"b; if current_argument = nargs then do; call com_err_ (error_table_$noarg, ME, "No log number giver with -number."); return; end; call get_next_argument; log_number = cv_dec_check_ (argument, code); if code ^= 0 then do; if code > length (argument) then call com_err_ (code, ME, "Could not convert ^a to a log number.", argument); else call com_err_ (error_table_$bad_conversion, ME, "Error converting ^a to a log number, character ^a in error.", argument, substr (argument, code, 1)); end; end; else if argument = "-a" | argument = "-all" then do; if have_log then do; call com_err_ (error_table_$inconsistent, ME, "-all may not be given with a log name.") ; goto RETURN; end; all_logs = "1"b; end; else if argument = "-print" | argument = "-pr" then do; have_print = "1"b; end; else if argument = "-no_print" | argument = "-no_pr" then do; have_print = "0"b; end; else if argument = "-time" | argument = "-tm" then do; if current_argument = nargs then do; /* theres no time there */ NO_TIME: call com_err_ (error_table_$noarg, ME, "A time must be specified for -time."); goto RETURN; end; call get_next_argument; if index (argument, "-") = 1 then goto NO_TIME; /* kludgily prevent negatives */ time = cv_dec_check_ (argument, code); if code ^= 0 then do; if code < length (argument) then call com_err_ (error_table_$bad_conversion, ME, "Error at character ^a of ^a.", substr (argument, code, 1), argument); else call com_err_ (code, ME, "Could not convert ^a to a time.", argument); goto RETURN; end; have_time = "1"b; end; else if argument = "-off" /* there is no -no_off. -off is too "dangerous". We could have -on but that would be confusing with -time or -print */ then do; if have_off then do; call com_err_ (error_table_$too_many_args, ME, "-off may only be given once."); go to RETURN; end; have_off = "1"b; end; else if argument = "-no_severity" | argument = "-no_sv" then do; if have_no_severity then do; call com_err_ (error_table_$too_many_args, ME, "-no_severity may only be given once."); go to RETURN; end; have_no_severity = "1"b; if have_severity then incon_severity: do; call com_err_ (error_table_$inconsistent, ME, "Both -severity and -no_severity were given."); go to RETURN; end; end; else if argument = "-severity" | argument = "-sv" then do; if have_no_severity then go to incon_severity; if current_argument = nargs then do; call com_err_ (error_table_$noarg, ME, "No severity given with -severity."); go to RETURN; end; call get_next_argument; severity = cv_dec_check_ (argument, code); if code ^= 0 then do; if index (argument, "-") = 1 then call com_err_ (error_table_$noarg, ME, "No severity given with -severity. Control argument ^a found instead.", argument); else if code < length (argument) then call com_err_ (error_table_$bad_conversion, ME, "Could not convert ^a to a severity. Error at character ^a.", argument, substr (argument, code, 1)); else call com_err_ (error_table_$badopt, ME, "Bad severity ^a.", argument); go to RETURN; end; have_severity = "1"b; end; else if argument = "-call" then do; if current_argument = nargs then do; call com_err_ (error_table_$noarg, ME, "No command to call was given."); return; end; call get_next_argument; command = argument; have_call = "1"b; end; else if argument = "-exclude" | argument = "-ex" | argument = "-match" then do; if (emtp = null ()) /* no temp yet */ then do; on cleanup call release_temp_segment_ (ME, emtp, code); call get_temp_segment_ (ME, emtp, code); if code ^= 0 then do; call com_err_ (code, ME, "no temp segs??"); return; end; em.matches, em.excludes, em.current = 0; end; state_flags.match = (argument = "-match"); if current_argument = nargs then do; NO_STRING: call com_err_ (error_table_$noarg, ME, "No ^[match^;exclude^] string given.", state_flags.match); goto RETURN; end; call get_next_argument; if index (argument, "-") = 1 then goto NO_STRING; /* have to have a string */ if (^state_flags.match & remove_exclude) | (state_flags.match & remove_match) then do; BAD_MEXC: call com_err_ (error_table_$inconsistent, ME, "Can't both remove and create exclusions or matches."); goto RETURN; end; em.current = em.current + 1; em.entries.string (em.current) = argument; em.entries.match (em.current) = state_flags.match; if state_flags.match then do; em.matches = em.matches + 1; have_match = "1"b; /* at least one */ end; else do; em.excludes = em.excludes + 1; have_exclude = "1"b; end; end; else if argument = "-remove_exclude" | argument = "-rmex" then do; if have_exclude then goto BAD_MEXC; remove_exclude = "1"b; end; else if argument = "-remove_match" | argument = "-rm_match" then do; if have_match then goto BAD_MEXC; remove_match = "1"b; end; else do; call com_err_ (error_table_$badopt, ME, "^a", argument); goto RETURN; end; end; /* Here ends the lexical phase (sic) aka the argument parsing loop. On to the syntactic analyzer, to verify that all the arguments really make sense */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* First check. If -all is specified, there must be something to do to them all. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ if all_logs & (string (action_options) = ""b) then do; /* -all must specify existing log op, not addition of new log */ call com_err_ (error_table_$inconsistent, ME, "-all is meaningless without a log operation."); goto RETURN; end; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Second check. There must be some log spec. Or -time, which applies to all logs. */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ if ^(all_logs | have_log | have_time | have_print) then do; call com_err_ (error_table_$noarg, ME, "No log name supplied."); goto RETURN; end; if ^have_log & ^have_time & have_print & ^have_off then all_logs = "1"b; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Okay, they pass. We have some log to work on and something to do to it. Let us begin. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ if have_time then do; monitor_log_invocations_.interval = time; if monitor_log_invocations_.active then do; call timer_manager_$reset_alarm_call (monitor_log_util_$wakeup_handler); call timer_manager_$alarm_call (monitor_log_invocations_.interval, "11"b, monitor_log_util_$wakeup_handler); end; end; if have_print then do; call ioa_ ("The wakeup interval is ^d second^[s^].", monitor_log_invocations_.interval, (monitor_log_invocations_.interval ^= 1)); end; if ^(have_log | all_logs) then return; /* thats all */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* From now on, the flag have_log is uninteresting. All_logs tells whether a particular */ /* log is under examination, and we have already reported an error if we had neither */ /* a log not -all. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ if ^all_logs /* find the one specified log, to see if we are making a new one */ then do; if have_numbered_log then call find_numbered_log (log_number, code); else call find_log (have_path, code); have_this_log = (code = 0); /* was it already active? */ if ^have_this_log & have_numbered_log /* if it was not, and was identified by number, we are stuck */ then do; call com_err_ (error_table_$inconsistent, ME, "Log number ^d is not active.", log_number); go to RETURN; end; if ^have_this_log & ^have_print & ^have_off /* all the other actions are also creation params */ then do; call new_log; go to RETURN; end; else do; /* just one log to be tweaked */ if ^have_this_log then do; call com_err_ (error_table_$name_not_found, ME, "No monitor set on the log ^a.", log_e); return; end; call process_a_log; go to RETURN; end; end; else do; /* all_logs */ if monitor_log_invocations_.lastp = monitor_log_invocations_.firstp then do; mlip = monitor_log_invocations_.firstp; if mlip = null then do; if ^(have_print & ^have_off) then call com_err_ (error_table_$name_not_found, ME, "There are no active logs."); go to RETURN; end; call process_a_log; go to RETURN; end; else loop_down_logs: begin; declare next_info_pointer pointer; do mlip = monitor_log_invocations_.firstp repeat (next_info_pointer) while (mlip ^= null ()); next_info_pointer = monitor_log_info.forwardp; call process_a_log; end; end loop_down_logs; go to RETURN; end; process_a_log: procedure; call process_match_exclude; if have_print then do; call ioa_ ("Log # ^i: ^a>^a: ^d entries;^[ Severity >= ^d^;^s^]^[ Calling ^a.^]", monitor_log_info.id, monitor_log_info.log_dir, monitor_log_info.log_entryname, monitor_log_info.last_count, monitor_log_info.filter_severity, monitor_log_info.severity, monitor_log_info.call, requote_string_ (rtrim (monitor_log_info.command_to_call))); if monitor_log_info.matches then call ioa_ ("^2xmatches:^(^5x""^a""^)", lm_match_array); if monitor_log_info.excludes then call ioa_ ("^2xexcludes:^(^5x""^a""^)", lm_exclude_array); end; if have_call then do; monitor_log_info.call = (command ^= ""); monitor_log_info.command_to_call = rtrim (command); end; if have_severity then do; monitor_log_info.filter_severity = "1"b; monitor_log_info.severity = severity; end; if have_no_severity then monitor_log_info.filter_severity = "0"b; if have_off then remove_log: begin options (non_quick); saved_ips_mask = ""b; call term_$single_refname (monitor_log_info.special_refname, (0)); on any_other call cease_monitoring_immediately; monitor_log_info.log_entryname = ""; /* signal to monitor_log_util_$wakeup_handler that entry is defunct */ call hcs_$set_ips_mask (""b, saved_ips_mask); on fixedoverflow begin; monitor_log_invocations_.change_pclock = 0; go to SET_PCLOCK; end; monitor_log_invocations_.change_pclock = monitor_log_invocations_.change_pclock + 1; SET_PCLOCK: if monitor_log_info.backp ^= null () then do; monitor_log_info.backp -> monitor_log_info.forwardp = monitor_log_info.forwardp; /* unlace */ end; else do; monitor_log_invocations_.firstp = monitor_log_info.forwardp; /* if backp was null, WE were first */ end; if monitor_log_info.forwardp ^= null then do; monitor_log_info.forwardp -> monitor_log_info.backp = monitor_log_info.backp; end; else do; monitor_log_invocations_.lastp = monitor_log_info.backp; /* if forwardp is null WE are last */ end; free monitor_log_info; if monitor_log_invocations_.lastp = null () & monitor_log_invocations_.firstp = null () then do; call timer_manager_$reset_alarm_call (monitor_log_util_$wakeup_handler); monitor_log_invocations_.id_pclock = 0; /* no more logs, we can reset */ monitor_log_invocations_.active = "0"b; end; call hcs_$reset_ips_mask (saved_ips_mask, saved_ips_mask); revert any_other; end remove_log; end process_a_log; process_match_exclude: procedure; declare (i, cm, ce) fixed bin; if (have_match | have_exclude) then do; if em.matches > 0 then do; if monitor_log_info.matches then free lm_match_array; monitor_log_info.n_matches = em.matches; allocate lm_match_array; monitor_log_info.matches = "1"b; end; if em.excludes > 0 then do; if monitor_log_info.excludes then free lm_exclude_array; monitor_log_info.n_excludes = em.excludes; allocate lm_exclude_array; monitor_log_info.excludes = "1"b; end; cm, ce = 0; do i = 1 to em.current; if em.entries (i).match then do; cm = cm + 1; lm_match_array (cm) = em.entries.string (i); end; else do; ce = ce + 1; lm_exclude_array (ce) = em.entries.string (i); end; end; call release_temp_segment_ (ME, emtp, code); emtp = null (); end; if remove_exclude & monitor_log_info.excludes then do; monitor_log_info.excludes = ""b; free lm_exclude_array; end; if remove_match & monitor_log_info.matches then do; monitor_log_info.matches = ""b; free lm_match_array; end; end process_match_exclude; find_log: procedure (path_switch, code); /* If the user specified a pathname we must decide if it is the same log as one we have. To do this we cannot just try to initiate, because a switch of segments might have happened. So if a path (as opposed to an entryname) has been given, we must run check_log_switch over each log so that the errors from refname$$initiate will be useful. We use the refname instead of a null refname to avoid the need to be always adding and removing spurious null refnames. */ declare path_switch bit (1); declare code fixed bin (35); declare got_it bit (1); declare the_logp pointer; declare numbered bit (1); declare number fixed bin; declare a_number fixed bin; numbered = ""b; go to common; find_numbered_log: entry (a_number, code); number = a_number; numbered = "1"b; common: got_it = ""b; code = 0; the_logp = null; do mlip = monitor_log_invocations_.firstp repeat (monitor_log_info.forwardp) while (^got_it & mlip ^= null ()); if /* tree */ numbered then if monitor_log_info.id = number then got_it = "1"b; else ; else if path_switch then if check_refname (log_d, log_e) then got_it = "1"b; else ; else if monitor_log_info.log_entryname = log_e then got_it = "1"b; if got_it then the_logp = mlip; /* save it */ end; if ^got_it then code = error_table_$noentry; mlip = the_logp; return; /* mlip will be correct */ end find_log; get_next_argument: procedure; current_argument = current_argument + 1; call cu_$arg_ptr (current_argument, ap, al, code); if code ^= 0 then do; call com_err_ (code, ME, "Looking for argument # ^d.", current_argument); goto RETURN; end; return; end; RETURN: if emtp ^= null () then call release_temp_segment_ (ME, emtp, code); return; cease_monitoring_immediately: procedure; call timer_manager_$reset_alarm_call (monitor_log_util_$wakeup_handler); monitor_log_invocations_.firstp, monitor_log_invocations_.lastp = null (); monitor_log_invocations_.active = "0"b; if saved_ips_mask ^= ""b then call hcs_$reset_ips_mask (saved_ips_mask, saved_ips_mask); call com_err_ (0, ME, "Internal inconsistency detected. All monitors removed."); go to RETURN; end cease_monitoring_immediately; new_log: procedure options (non_quick); /* it sets a handler */ mlip = null (); on cleanup begin; if mlip ^= null () then free monitor_log_info; end; saved_ips_mask = ""b; allocate monitor_log_info; monitor_log_info.sentinel = monitor_log_sentinel_v1; monitor_log_info.log_dir = log_d; monitor_log_info.log_entryname = log_e; monitor_log_info.exclude_p, monitor_log_info.match_p = null (); monitor_log_info.special_refname = unique_chars_ (""b); call monitor_log_util_$initiate_log (mlip, code); if monitor_log_info.logp = null () then do; free monitor_log_info; call com_err_ (code, ME, "^a>^a", log_d, log_e); goto RETURN; end; monitor_log_invocations_.id_pclock = monitor_log_invocations_.id_pclock + 1; monitor_log_info.id = monitor_log_invocations_.id_pclock; monitor_log_info.call = have_call; if have_call then monitor_log_info.command_to_call = command; else monitor_log_info.command_to_call = ""; call process_match_exclude; /* this is complex */ monitor_log_info.last_count = monitor_log_info.logp -> sys_log_file.count; on any_other begin; if saved_ips_mask = ""b then call continue_to_signal_ (0); else do; call cease_monitoring_immediately; call hcs_$reset_ips_mask (saved_ips_mask, ""b); call continue_to_signal_ (0); end; end; call hcs_$set_ips_mask (""b, saved_ips_mask); on fixedoverflow begin; monitor_log_invocations_.change_pclock = 0; go to SET_PCLOCK; end; monitor_log_invocations_.change_pclock = monitor_log_invocations_.change_pclock + 1; SET_PCLOCK: revert fixedoverflow; monitor_log_info.forwardp = null (); monitor_log_info.backp = monitor_log_invocations_.lastp; if monitor_log_invocations_.lastp ^= null () then /* first entry */ monitor_log_invocations_.lastp -> monitor_log_info.forwardp = mlip; else monitor_log_invocations_.firstp, monitor_log_invocations_.lastp = mlip; monitor_log_invocations_.lastp = mlip; call hcs_$reset_ips_mask (saved_ips_mask, saved_ips_mask); revert any_other; if ^monitor_log_invocations_.active then do; call timer_manager_$alarm_call (monitor_log_invocations_.interval, "11"b, monitor_log_util_$wakeup_handler); monitor_log_invocations_.active = "1"b; end; end new_log; check_refname: procedure (dir, entryname) returns (bit (1) aligned); declare (dir, entryname) character (*); declare cls_result bit (2) aligned; declare temp_log_ptr pointer; declare code fixed bin (35); call monitor_log_util_$initiate_path (dir, entryname, monitor_log_info.special_refname, temp_log_ptr, code); if code = 0 then return ("0"b); /* this is impossible. It would imply that the refname had gone away. */ else if code = error_table_$segknown /* this is the right log */ then return ("1"b); else if code = error_table_$namedup /* refname on another seg, check switch justincase */ then do; if monitor_log_util_$check_log_switch (mlip) = LOG_SWITCHED /* well, perhaps it is the correct log */ then if temp_log_ptr = monitor_log_info.logp then return ("1"b); /* same thing */ else return ("0"b); else return ("0"b); end; else return ("0"b); end check_refname; end monitor_log;  monitor_log_util_.pl1 01/16/85 1233.0r w 01/16/85 1229.9 78597 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* monitor_log_util_ -- actual examiner of the logs, separated out for efficiency */ /* format: style2 */ monitor_log_util_: procedure; /* Coded 1981 March 4 Benson I. Margulies */ /* bugs in log switching addresed BIM 11/82 */ %page; %include monitor_log_info_; %page; %include syslog; %page; declare cu_$cp entry (ptr, fixed bin (21), fixed bin (35)); declare hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35)); declare hcs_$terminate_name entry (char (*), fixed bin (35)); declare hcs_$status_minf entry (char (*), char (*), fixed bin (1), fixed bin (2), fixed bin (24), fixed bin (35)); declare ioa_$rsnpnnl entry options (variable); declare iox_$control entry (ptr, char (*), ptr, fixed bin (35)); declare ioa_ entry () options (variable); declare requote_string_ entry (char (*)) returns (char (*)); declare timer_manager_$alarm_call entry (fixed bin (71), bit (2), entry); declare ( error_table_$namedup, error_table_$segknown ) external static fixed bin (35); declare iox_$user_io pointer external static; declare saved_pclock fixed bin (35); declare code fixed bin (35); declare sys_log_ptr pointer; declare cleanup condition; declare any_other condition; declare seg_fault_error condition; declare out_of_bounds condition; declare ( (Log_pointer, Info_pointer) pointer, (Dir_name, Entryname, Refname) character (*), Code fixed binary (35) ) parameter; wakeup_handler: entry; /* gets timer_manager_ wakeups */ on any_other system; /* isolate from things further up */ on cleanup call reset; /* dont lose wakeup */ on seg_fault_error, /* moved or deleted */ out_of_bounds /* something else went awry */ begin; declare log_state bit (2); log_state = check_log_switch (); if log_state = LOG_SWITCHED then go to RECONSIDER_LOG; else go to SKIP_LOG; /* maybe it will be in a better state next tick */ end; /* Try to be robust across changes made by a call handler */ RESTART_CHECK: /* come here if a -call disturbs the threads */ do mlip = monitor_log_invocations_.firstp repeat (monitor_log_info.forwardp) while (mlip ^= null ()); RECONSIDER_LOG: saved_pclock = monitor_log_invocations_.change_pclock; if monitor_log_info.log_entryname ^= "" /* not deleted */ then do; sys_log_ptr = monitor_log_info.logp; /* first print for the simple case, which is just new messages in the existing log. */ if sys_log_file.count > monitor_log_info.last_count then call printup; /* next check for a switch in the log segments. */ else if sys_log_file.count = monitor_log_info.last_count & sys_log_file.count >= sys_log_file.max then if check_log_switch () = LOG_SWITCHED then call printup; /* try again */ end; SKIP_LOG: if monitor_log_invocations_.change_pclock ^= saved_pclock then go to RESTART_CHECK; end; call reset; return; reset: procedure; if monitor_log_invocations_.firstp ^= null () then call timer_manager_$alarm_call (monitor_log_invocations_.interval, "11"b, wakeup_handler); end reset; printup: procedure; declare im fixed bin; declare printit bit (1); declare last_message_we_see fixed bin; declare message_length fixed bin (21); declare command character (512) aligned; declare i fixed bin; last_message_we_see = sys_log_file.count; do i = monitor_log_info.last_count + 1 to last_message_we_see; printit = "0"b; /* assume we will not print */ if monitor_log_info.matches then do im = 1 to monitor_log_info.n_matches;/* any match will do */ printit = printit | (index (sys_log_file.array (i).line, lm_match_array (im)) > 0); end; else printit = "1"b; /* unless there are no match requirements, in which case we assume we do */ if monitor_log_info.filter_severity then printit = printit & (sys_log_file.array (i).svty >= monitor_log_info.severity); if monitor_log_info.excludes then do im = 1 to monitor_log_info.n_excludes; /* any serve to exclude */ printit = printit & ^(index (sys_log_file.array (i).line, lm_exclude_array (im)) > 0); end; if printit then do; if monitor_log_info.call then do; call ioa_$rsnpnnl ("^a ^a ^d ^d ^a", command, message_length, rtrim (monitor_log_info.command_to_call), monitor_log_info.log_entryname, i, sys_log_file.array (i).svty, requote_string_ (rtrim (sys_log_file.array (i).line))); call cu_$cp (addr (command), message_length, (0)); end; else do; call ioa_ ("^a ^d ^d ^a", monitor_log_info.log_entryname, i, sys_log_file.array (i).svty, sys_log_file.array (i).line); end; end; end; monitor_log_info.last_count = last_message_we_see; call iox_$control (iox_$user_io, "start", null (), code); return; end printup; refname$$initiate: procedure (log_ptr, code); declare log_ptr pointer; declare code fixed bin (35); declare (dir, entryname, refname) character (*); declare temp_code fixed bin (35); call hcs_$initiate (monitor_log_info.log_dir, monitor_log_info.log_entryname, monitor_log_info.special_refname, 0, 1, log_ptr, code); return; refname$$initiate_path: entry (dir, entryname, refname, log_ptr, code); call hcs_$initiate (dir, entryname, refname, (0), (1), log_ptr, code); return; refname$$terminate: entry (); call hcs_$terminate_name (monitor_log_info.special_refname, temp_code); return; end refname$$initiate; check_log_switch: procedure returns (bit (2) aligned); declare temp_logp pointer; /* if a switch has completed, then the special refname will be stuck on the old segment, which will have a new name. If the switch is only partway done, the rename will have happened but the new segment will not yet exist. If this program detects the rename, then it terminates the special refname. If it then finds that the new segment is not available yet, it does not bother to try to put the refname back on the renamed segment. So the next time we look at this log, we will try to initiate with the refname, the initiate call will return segknown or no error. The only remaining difficulty is that we may wind up terminating the renamed segment altogether. To prevent this a status_minf call is made before the reference name is terminated. */ call refname$$initiate (temp_logp, code); if (code = 0) /* this is impossible unless there was an error of some kind */ then do; call refname$$terminate; return (NO_SUCH_LOG); end; else if (code = error_table_$segknown) then do; /* seg at this path has this refname */ return (NO_LOG_SWITCH); /* so there was no turnover */ end; else if code = error_table_$namedup then do; /* seg at another pathname has this refname */ /* so a rename has happened */ /* insure that the new one is there */ call hcs_$status_minf (monitor_log_info.log_dir, monitor_log_info.log_entryname, (0), (0), (0), code); if code ^= 0 then return (NO_LOG_SWITCH); /* not yet ... window we cannot close */ call refname$$terminate; call refname$$initiate (temp_logp, code); if monitor_log_info.logp = null () /* we could call sub_err_, but */ then do; return (NO_LOG_SWITCH); end; monitor_log_info.logp = temp_logp; monitor_log_info.last_count = 0; sys_log_ptr = monitor_log_info.logp; /* new log */ return (LOG_SWITCHED); end; return (NO_LOG_SWITCH); /* some other error from initiate */ end check_log_switch; initiate_log: entry (Info_pointer, Code); Code = 0; mlip = Info_pointer; call refname$$initiate (monitor_log_info.logp, Code); return; initiate_path: entry (Dir_name, Entryname, Refname, Log_pointer, Code); call refname$$initiate_path (Dir_name, Entryname, Refname, Log_pointer, Code); return; monitor_log_util_$check_log_switch: entry (Info_pointer) returns (bit (2) aligned); mlip = Info_pointer; return (check_log_switch ()); end monitor_log_util_;  print_log.pl1 01/16/85 1233.0rew 01/16/85 1229.9 131274 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ %; /* ****************************************************** * * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * * * ****************************************************** */ print_log: proc; /* PRINT_LOG - print the answering service logs THVV */ /* args changed 7/76 THVV */ /* Modified March 1979 by T. Casey to add ability to automatically chase backpointers to previous logs. */ dcl path char (168) aligned init (">system_control_1>log"), dn char (168) aligned, en char (32) aligned, print_count fixed bin init (0), shx fixed bin, nsharg fixed bin init (0), searcharg (32) char (64) varying, nexclarg fixed bin init (0), exclarg (32) char (64) varying, ioa_ entry options (variable), hcs_$initiate entry (char (*)aligned, char (*) aligned, char (*) aligned, fixed bin (1), fixed bin (2), ptr, fixed bin (35)), hcs_$terminate_noname entry (ptr, fixed bin (35)), expand_path_ entry (ptr, fixed bin, ptr, ptr, fixed bin (35)), ec fixed bin (35), cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)), cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)), convert_date_to_binary_ entry (char (*), fixed bin (71), fixed bin (35)), xtime fixed bin (71), start_time fixed bin (71) initial (0), end_time fixed bin (71) init /* This date is 12/31/99 2359. */ (1011000110010110011001001110100110111010100100000000b), /* .. if Multics last this long we will have to fix */ bchr char (al) based (ap) unaligned, hdsw bit (1) aligned init ("1"b), negative bit (1) init ("0"b), ap ptr, al fixed bin, date_time_ entry (fixed bin (71), char (*) aligned), sys_log_ptr ptr, com_err_ entry options (variable), timestr char (16) aligned, odate char (8) aligned init (" "), istart fixed bin init (1), i fixed bin, ss fixed bin init (0), pl fixed bin init (23), an fixed bin init (1); dcl log_ptrs (200) ptr; /* should never need to look at more than 200 previous logs */ dcl history (200) bit (1) unaligned; dcl xlls (200) char (12); dcl n_logs fixed bin init (0); /* how many of the above pointers are valid */ dcl log_no fixed bin; /* which one are we printing now */ dcl first_msg_found bit (1) aligned; /* to tell when we have looked back far enough */ dcl pathsw bit (1) aligned init (""b); /* on if log pathname given */ dcl sysdir char (168) init (">sc1"); dcl log_name char (32) init ("log"); dcl history_dir char (168) init (">udd>SysAdmin>admin>history"); dcl iend fixed bin init (0); /* number of last message, if -to N given */ dcl convert_date_to_binary_$relative entry (char (*), fixed bin (71), fixed bin (71), fixed bin (35)); dcl prev_arg char (32); /* saved previous argument, for error messages */ dcl me char (9) int static options (constant) init ("print_log"); dcl fb71 fixed bin (71); dcl for_time_string char (32) init (""); dcl error_table_$noentry ext fixed bin (35); dcl n_msgs fixed bin init (0); dcl error_table_$badopt ext fixed bin (35); dcl (abs, addr, hbound, index, null, rtrim, substr) builtin; dcl cleanup condition; %include syslog; /* ======================================================= */ history (1) = ""b; an = 1; arglp: call cu_$arg_ptr (an, ap, al, ec); if ec ^= 0 then go to endarg; if bchr = "-a" | bchr = "-all" then ss = 0; /* obsolete */ else if bchr = "-n" then ss = 1; /* obsolete */ else if bchr = "-e" then ss = 2; /* obsolete */ else if bchr = "-severity" | bchr = "-sv" then do; call get_next_arg; ss = cv_dec_check_ (bchr, ec); if ec ^= 0 then do; call com_err_ (0, "print_log", "Illegal -severity: ^a", bchr); return; end; end; else if bchr = "-nhdr" | bchr = "-no_header" | bchr = "-nhe" then hdsw = "0"b; else if (bchr = "-word" | bchr = "-match") then do; call get_next_arg; ml1: nsharg = nsharg + 1; if nsharg <= hbound (searcharg, 1) then searcharg (nsharg) = bchr; else call com_err_ (0, "print_log", "-match arg ^a ignored - limit ^d", bchr, hbound (searcharg, 1)); an = an + 1; call cu_$arg_ptr (an, ap, al, ec); if ec = 0 then if substr (bchr, 1, 1) ^= "-" then go to ml1; go to arglp; end; else if (bchr = "-ex" | bchr = "-exclude") then do; call get_next_arg; ml2: nexclarg = nexclarg + 1; if nexclarg <= hbound (exclarg, 1) then exclarg (nexclarg) = bchr; else call com_err_ (0, "print_log", "-exclude arg ^a ignored - limit ^d", bchr, hbound (exclarg, 1)); an = an + 1; call cu_$arg_ptr (an, ap, al, ec); if ec = 0 then if substr (bchr, 1, 1) ^= "-" then go to ml2; go to arglp; end; else if bchr = "-tm" | bchr = "-time" | bchr = "-date" | bchr = "-dt" then do; call get_next_arg; call convert_date_to_binary_ (bchr, start_time, ec); if ec ^= 0 then go to arg_err; end; else if bchr = "-to" then do; call get_next_arg; call convert_date_to_binary_ (bchr, xtime, ec); if ec = 0 then end_time = xtime; else do; iend = cv_dec_check_ (bchr, ec); if ec ^= 0 then go to date_dec_err; end; end; else if bchr = "-from" | bchr = "-fm" then do; call get_next_arg; call convert_date_to_binary_ (bchr, xtime, ec); if ec = 0 then start_time = xtime; else do; /* Not a date, see if number */ i = cv_dec_check_ (bchr, ec); if ec ^= 0 then goto date_dec_err; else istart = i; end; end; else if bchr = "-last" then do; call get_next_arg; i = cv_dec_check_ (bchr, ec); if ec ^= 0 then goto dec_err; else istart = -i; end; else if bchr = "-for" | bchr = "-next" then do; call get_next_arg; print_count = cv_dec_check_ (bchr, ec); if ec ^= 0 then do; /* must be a date-time */ print_count = 0; for_time_string = bchr; /* it is a relative date-time - e.g., "1hour" */ end; /* so wait 'til we know the first message's date-time, before converting the relative date-time */ end; else if bchr = "-sysdir" then do; call get_next_arg; sysdir = bchr; end; else if bchr = "-history_dir" then do; call get_next_arg; history_dir = bchr; end; else if bchr = "-log" | bchr = "-log_name" | bchr = "-et" | bchr = "-entry" then do; call get_next_arg; log_name = bchr; end; else if substr (bchr, 1, 1) = "-" then do; i = cv_dec_check_ (bchr, ec); /* check for negative number */ if ec = 0 then do; istart = i; goto nxtarg; end; call com_err_ (error_table_$badopt, "print_log", "^a", bchr); /* if it's not a negative number, it must be an error */ return; end; else do; /* obsolete */ i = cv_dec_check_ (bchr, ec); if ec = 0 then do; istart = i; go to nxtarg; end; path = bchr; pl = al; pathsw = "1"b; call expand_path_ (addr (path), pl, addr (dn), addr (en), ec); if ec ^= 0 then goto arg_err; end; nxtarg: an = an + 1; go to arglp; endarg: /* Find first message to be printed. Might have to chase backpointers to previous logs. Only chase backpointers when log pathname not given. If -from DATE given and DATE is before first date in current log, or -last N given and there are less than N messages in logs initiated so far, then look in previous logs to find first message. */ if ^pathsw then do; /* if path not given, start with current log */ dn = sysdir; en = log_name; end; on cleanup call terminate_logs; /* set up cleanup handler before initiating logs */ first_msg_found = ""b; do while (^first_msg_found); /* keep looking 'til we find it */ if n_logs ^< hbound (log_ptrs, 1) then do; /* if too many logs initiated */ call com_err_ (0, me, "Limit of ^d previous logs exceeded.", hbound (log_ptrs, 1)); first_msg_found = "1"b; /* pretend we found it, and print what we have */ end; else do; /* initiate another log, and look at it */ log_ptrs (n_logs+1) = null; /* in case of cleanup */ n_logs = n_logs + 1; try_initiate: call hcs_$initiate (dn, en, "", 0, 1, log_ptrs (n_logs), ec); if log_ptrs (n_logs) = null then do; /* if initiate failed */ if ec = error_table_$noentry & n_logs > 1 then do; /* previous log not there */ if n_logs >= 2 & dn = sysdir then do; /* previous log not in sysdir */ dn = history_dir; /* it was probably moved to history directory */ goto try_initiate; /* so much for gotoless programming */ end; else do; /* logs not saved that far back */ if n_logs = 2 then /* immediately previous log not found */ call com_err_ (0, me, "Previous ^a not found in ^a", en, dn); else do; /* some logs found, but not back far enough */ if istart ^< 0 then do; /* if -last N not given, -from DATE must have been */ call date_time_ (time (1), timestr); call com_err_ (0, me, "Saved logs go back only to ^a.", timestr); end; else call com_err_ (0, me, "Saved logs contain only the last ^d messages.", n_msgs); end; first_msg_found = "1"b; /* stop looking, and print what we have */ n_logs = n_logs - 1; /* don't try to print the one that wasn't there */ end; end; /* end previous log not there */ else do; /* real error */ call com_err_ (ec, me, "^a>^a", dn, en); goto cleanup_and_return; end; end; /* end initiate failed */ else if n_logs > 1 then do; /* save info for printing log pathname in heading */ if dn = history_dir then history (n_logs) = "1"b; xlls (n_logs) = lls; end; sys_log_ptr = log_ptrs (n_logs); /* set pointer that log structure is based on */ /* See if this log contains the starting message that we want */ n_msgs = n_msgs + count; /* total messages in all initiated logs */ if ^pathsw /* if log pathname not given */ & (start_time > 0 & start_time < time (1) /* and -from DATE given and DATE isn't in this log */ | istart < 0 & abs (istart) > n_msgs /* or -last N given and logs don't have N messages yet */ | count = 0) /* or log is empty (just contains name of previous one) */ then en = rtrim (log_name) || ".-." || rtrim (lls); /* then construct entry name of previous log, and look for it by staying in the loop */ else first_msg_found = "1"b; /* else first msg is in this log so stop looking */ end; /* end log_ptrs array not full */ end; /* end do while ^first_msg_found */ /* We've found the log containing the first message. Now find the index of the message */ if istart < 0 then /* if -last N given */ istart = n_msgs + istart + 1; /* equivalent to n_msgs - N + 1 */ if istart < 1 then istart = 1; /* if we don't have N messages, start with first one */ if start_time > 0 then /* if -from DATE given */ do istart = istart to count /* scan log */ while (time (istart) < start_time); end; /* for first message at or after that date-time */ /* Now see if -for TIME was given. If so, compute end time relative to start time */ if for_time_string ^= "" then do; /* if -for TIME was given */ if start_time > 0 then /* if -from DATE was given */ fb71 = start_time; /* use that time */ else fb71 = time (istart); /* otherwise use time of starting message */ call convert_date_to_binary_$relative (for_time_string, end_time, fb71, ec); if ec ^= 0 then do; call com_err_ (ec, me, "^a", for_time_string); goto cleanup_and_return; end; end; /* Now print the log(s) */ do log_no = n_logs to 1 by -1; sys_log_ptr = log_ptrs (log_no); /* copy pointer to log to be printed */ call date_time_ (ttime, timestr); if hdsw then do; if ^pathsw then do; /* unless path arg given, construct path to print in heading */ if history (log_no) then dn = history_dir; else dn = sysdir; if log_no = 1 then en = log_name; else en = rtrim (log_name) || ".-." || rtrim (xlls (log_no)); end; call ioa_ ("^/""^a>^a"" - ^d entries, last ^a^/", dn, en, count, timestr); end; do i = istart to count; if time (i) > end_time then go to endlp1; if svty (i) < ss then go to endlp; do shx = 1 to nsharg while (index (line (i), searcharg (shx)) = 0); end; if nsharg > 0 & shx > nsharg then go to endlp; /* If all fail skip */ do shx = 1 to nexclarg while (index (line (i), exclarg (shx)) = 0); end; if nexclarg > 0 & shx <= nexclarg then go to endlp; /* If any found skip */ call date_time_ (time (i), timestr); if substr (timestr, 1, 8) = odate then substr (timestr, 1, 8) = " "; else odate = substr (timestr, 1, 8); call ioa_ ("^4d ^16a ^d ^a", i, timestr, svty (i), line (i)); print_count = print_count - 1; if print_count = 0 then go to endlp1; if iend > 0 & i = iend then goto endlp1; endlp: end; istart = 1; /* start at beginning of next log */ end; /* end loop thru several logs */ endlp1: call ioa_ (""); cleanup_and_return: call terminate_logs; return; arg_err: call com_err_ (ec, me, "^a", bchr); return; date_dec_err: call com_err_ (0, me, "Argument after ^a not date or decimal number: ^a", prev_arg, bchr); return; dec_err: call com_err_ (0, me, "Invalid decimal number (digit ^d): ^a", ec, bchr); return; noarg_err: call com_err_ (ec, me, "after ""^a""", prev_arg); return; /* ********** INTERNAL PROCEDURES ********** */ get_next_arg: proc; prev_arg = bchr; /* save current argument, for possible error message */ an = an + 1; /* increment argument index */ call cu_$arg_ptr (an, ap, al, ec); if ec ^= 0 then goto noarg_err; return; end get_next_arg; /* ********** ********** */ terminate_logs: proc; dcl i fixed bin; do i = 1 to n_logs; call hcs_$terminate_noname (log_ptrs (i), (0)); end; return; end terminate_logs; end print_log;  write_log_.pl1 01/16/85 1233.0rew 01/16/85 1229.9 31680 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ write_log_: proc (dtime, xsv, lin); /* WRITE_LOG_ - add an entry to a system control log file. THVV */ dcl dtime fixed bin (71), xsv fixed bin, lin char (*); dcl logptr ptr int static init (null); /* ptr to standard log. */ dcl dn char (64) aligned int static init (">system_control_1"); dcl hcs_$terminate_noname entry (ptr, fixed bin); dcl hcs_$make_seg entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed bin (5), ptr, fixed bin); dcl copy_acl_ entry (char (*) aligned, char (*) aligned, char (*) aligned, char (*) aligned, bit (1), fixed bin); dcl hcs_$chname_seg entry (ptr, char (*) aligned, char (*) aligned, fixed bin); dcl date_time_ entry (fixed bin (71), char (*) aligned); dcl ioa_$rsnnl entry options (variable); dcl en char (32) aligned; dcl sys_log_ptr ptr; dcl filesw bit (1) aligned; dcl xlls char (32) aligned init (""); dcl ec fixed bin; dcl i fixed bin; dcl timestr char (16) aligned; dcl on char (32) aligned; dcl (null, substr) builtin; %include syslog; /* -------------------------------------------------------- */ en = "log"; /* Default name. */ sys_log_ptr = logptr; /* .. dft ptr */ filesw = "0"b; go to join; /* Entry point used if writing to other than default log file. */ write_log_file: entry (dtime, xsv, lin, sname, logp); dcl sname char (*), /* Name of log file to write. */ logp ptr; /* ptr to log */ sys_log_ptr = logp; /* Copy args */ en = sname; /* .. */ filesw = "1"b; join: if sys_log_ptr = null then do; /* Do we know where file is? */ refind: call hcs_$make_seg (dn, en, "", 1011b, sys_log_ptr, ec); if sys_log_ptr = null then return; /* can't happen */ if filesw then logp = sys_log_ptr; /* Found new log maybe */ else logptr = sys_log_ptr; /* Anyway, make avail for next time. */ if sys_log_file.max = 0 then do; /* new segment? */ sys_log_file.max = 2047; /* 64K segment */ sys_log_file.lls = xlls; /* save name of old one */ call copy_acl_ (dn, on, dn, en, ("0"b), (0)); end; end; if sys_log_file.count >= sys_log_file.max then do; call date_time_ (dtime, timestr); xlls = substr (timestr, 11, 4) || "-" || substr (timestr, 1, 5); call ioa_$rsnnl ("^a.-.^a", on, i, en, xlls); /* Make name for old log. */ call hcs_$chname_seg (sys_log_ptr, en, on, ec); if ec ^= 0 then return; /* can't happen */ call hcs_$terminate_noname (sys_log_ptr, ec); go to refind; /* now make new segment */ end; sys_log_file.count = sys_log_file.count + 1; /* increase count */ sys_log_file.ttime = dtime; /* set last-time-logged */ i = sys_log_file.count; /* get into XR */ sys_log_file.array (i).time = dtime; /* set time of message */ sys_log_file.array (i).svty = xsv; /* ... severity */ sys_log_file.array (i).line = lin; /* ... formatted line */ return; /* Entry point for testing. */ write_log_test: entry (xdir); dcl xdir char (*); dn = xdir; end write_log_; bull_copyright_notice.txt 08/30/05 1008.4r 08/30/05 1007.3 00020025 ----------------------------------------------------------- Historical Background This edition of the Multics software materials and documentation is provided and donated to Massachusetts Institute of Technology by Group Bull including Bull HN Information Systems Inc. as a contribution to computer science knowledge. This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology, Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell Bull Inc., Groupe Bull and Bull HN Information Systems Inc. to the development of this operating system. Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970), renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership of Professor Fernando Jose Corbato.Users consider that Multics provided the best software architecture for managing computer hardware properly and for executing programs. Many subsequent operating systems incorporated Multics principles. Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. . ----------------------------------------------------------- Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without fee is hereby granted,provided that the below copyright notice and historical background appear in all copies and that both the copyright notice and historical background and this permission notice appear in supporting documentation, and that the names of MIT, HIS, Bull or Bull HN not be used in advertising or publicity pertaining to distribution of the programs without specific prior written permission. Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc. Copyright 2006 by Bull HN Information Systems Inc. Copyright 2006 by Bull SAS All Rights Reserved