@q
@program errorcheck.muf
1 99999 d
i
( errorcheck.muf v1.0 Jessy @ FurryMUCK 11/99
A MUF error reporting utility.
INSTALLATION:
Set errorcheck.muf Wizard, so it can manipulate the .debug/ directory
of programs.
Create a global action and link it to the program.
USE:
<cmd> <prog> ............. Show detailed report for <prog>
<cmd> #all ............... Scan db. List programs with error records
<cmd> #clear <prog> ...... Clear error record for <prog>
<cmd> #clear all ......... Clear error records on all progs you own
<cmd> #clear dbase ....... Clear all error records in dbase [wiz only]
<cmd> #track <command> ... Include username in <command> error records
<cmd> #!track <command> .. Omit username from <command> error records
The '#all', '#clear all', and '#clear dbase' options must scan the database,
which may take a significant amount of time. #Option strings do not have to
be typed completely.
Errorcheck.muf may be freely ported. Please comment any changes.
)
(2345678901234567890123456789012345678901234567890123456789012345678901)
lvar ourArg (* str: cmd arg... may be modified *)
lvar ourObj (* dbref: object to handle or report *)
lvar ourOpt (* str: #option string *)
$define Tell me @ swap notify $enddef
: DoMatchObj ( s -- ) (* match s; store in ourObj *)
#-1 ourObj !
ourArg @ match
dup #-1 dbcmp if
">> I don't see that here." Tell pop pid kill
then
dup #-2 dbcmp if
">> Ambiguous. I don't know which one you mean." Tell pop pid kill
then
me @ over controls not if
">> Permission denied." Tell pop pid kill
then
ourObj !
;
: DoHelp ( -- ) (* show help screen *)
" " Tell
prog name " (#" strcat prog intostr strcat ")" strcat Tell " " Tell
"This command reports errors for programs you control." Tell " " Tell
" $command [<prog>] ........... Show detailed report for <prog>"
command @ "$command" subst Tell
" $command #all ............... Scan db. List programs with error records"
command @ "$command" subst Tell
" $command #clear <prog> ...... Clear error record for <prog>"
command @ "$command" subst Tell
" $command #clear all ......... Clear error records on all programs you own"
command @ "$command" subst Tell
" $command #clear dbase ....... Clear all error records in dbase (wiz only)"
command @ "$command" subst Tell
" $command #track <command> ... Include username in <cmd> error records"
command @ "$command" subst Tell
" $command #!track <command> .. Omit username from <cmd> error records"
command @ "$command" subst Tell " " Tell
"The '#all', '#clear all', and '#clear dbase' options must scan the "
"database, which may take a significant amount of time. #Option strings "
"do not have to be typed completely. Program to report defaults to the "
"last program specified."
strcat strcat strcat Tell " " Tell
;
: DoAll ( -- ) (* scan db for .debug/ entries *)
(* report all for progs controlled by user *)
":> Scanning dbase for .debug entries..." Tell
background (* may take a while... go to background *)
0
begin (* scan db objects... *)
dup dbref
dup dbtop dbcmp not while (* more to check? *)
dup ok? if (* ok dbref? *)
me @ over controls if (* user controls? *)
dup program? if (* it's a program? *)
dup ".debug/errcount" getprop if (* has errors? *)
dup unparseobj " " swap strcat " = " strcat (* show *)
over ".debug/errcount" getprop intostr strcat Tell
then
then
then
then
pop 1 +
repeat
pop
">> Done." Tell
;
: DoClear ( -- ) (* clear what's specified by ourArg *)
ourArg @ not if (* check syntax *)
">> Syntax: $command #clear <prog|all|dbase>"
command @ "$command" subst Tell exit
then
(* clear all errors on objs *owned* by user *)
(* this means wizzes can clear all, without clearing others' progs *)
"all" ourArg @ smatch if
">> Clearing dbase of .debug entries for your programs..." Tell
background
0
begin (* scan db... *)
dup dbref
dup dbtop dbcmp not while (* more to check? *)
dup ok? if (* ok dbref? *)
dup owner me @ dbcmp if (* user owns it? *)
dup program? if (* it's a program? *)
dup ".debug/errcount" remove_prop (* clear it *)
dup ".debug/lastcrash" remove_prop
dup ".debug/lasterr" remove_prop
dup ".debug/lastuser" remove_prop
dup ".debug/prevuser" remove_prop
dup ".debug/prevuser" remove_prop
then
then
then
pop 1 +
repeat
pop
">> Done." Tell exit
then
(* this way clears all errors, regardless of ownership *)
"dbase" ourArg @ smatch if
me @ "W" flag? not if ">> Permission denied." Tell exit then
">> Clearing dbase of .debug entries..." Tell
background
0
begin (* scan db... *)
dup dbref
dup dbtop dbcmp not while (* more to check? *)
dup ok? if (* ok dbref? *)
me @ over controls if (* user controls it? *)
dup program? if (* it's a program? *)
dup ".debug/errcount" remove_prop (* clear it *)
dup ".debug/lastcrash" remove_prop
dup ".debug/lasterr" remove_prop
dup ".debug/lastuser" remove_prop
dup ".debug/prevuser" remove_prop
then
then
then
pop 1 +
repeat
pop
">> Done." Tell exit
then
DoMatchObj (* this way for a single object *)
ourObj @ program? not if
">> That's not a program." Tell pid kill
then
ourObj @ ".debug/errcount" remove_prop
ourObj @ ".debug/lastcrash" remove_prop
ourObj @ ".debug/lasterr" remove_prop
ourObj @ ".debug/lastuser" remove_prop
ourObj @ ".debug/prevuser" remove_prop
">> Cleared." Tell exit
;
: DoTrack ( -- ) (* add props to track user when bug occurs *)
(* if prevuser and lastcrash have the same systime, then prevuser
holds dbref of player using program when it errored. move this
to lastuser, to be included in reports *)
trig getlink dup if
ourObj !
ourObj @ ".debug/prevuser" getprop
ourObj @ ".debug/lastcrash" getprop and if
ourObj @ ".debug/prevuser" getprop
ourObj @ ".debug/lastcrash" getprop
intostr "::" swap strcat instr if
ourObj @ ".debug/prevuser" getprop
dup "::" instr 1 - strcut pop atoi dbref
ourObj @ ".debug/lastuser" rot setprop
then
then
ourObj @ ".debug/prevuser" (* now set current user as prevuser *)
me @ intostr "::" strcat systime intostr strcat
setprop
else
pop
then
;
: DoSetTrack ( s -- ) (* set MPI to trigger tracking for cmd s *)
DoMatchObj
ourObj @ exit? not if
">> That's not a command." Tell pid kill
then
ourObj @ getlink not if
">> Exit is not linked to a program." Tell pid kill
then
ourObj @ "_/sc" getpropstr
"{null:{muf:#$prog,~&track&~}}"
prog intostr "$prog" subst
over over instr if (* just pretend if it's already set *)
pop pop
else
strcat ourObj @ swap setsucc
then
">> Set." Tell
;
: DoNoTrack ( s -- ) (* remove MPI triggering tracking for cmd s *)
DoMatchObj
ourObj @ "_/sc" over over
getpropstr ""
"{null:{muf:#$prog,~&track&~}}"
prog intostr "$prog" subst subst
setprop
">> Set." Tell
;
: DoCheck ( -- ) (* show report for a single program *)
ourArg @ if (* if arg given, match and use that *)
DoMatchObj
else (* otherwise, use last prog we reported on *)
me @ "_prefs/bcheck-last" getprop dup if
ourObj !
else (* ... if we have one, that is *)
pop
DoHelp exit
then
then
me @ ourObj @ controls if (* check permission; record report *)
me @ "_prefs/bcheck-last" ourObj @ setprop
else
">> Permission denied." Tell exit
then
ourObj @ ".debug/prevuser" getprop
ourObj @ ".debug/lastcrash" getprop and if
ourObj @ ".debug/prevuser" getprop
ourObj @ ".debug/lastcrash" getprop
intostr "::" swap strcat instr if
ourObj @ ".debug/prevuser" getprop
dup "::" instr 1 - strcut pop atoi dbref
ourObj @ ".debug/lastuser" rot setprop
then
then
(* show .debug/ info for our prog, nicely formatted *)
">> Error report for $program:"
ourObj @ unparseobj "$program" subst Tell " " Tell
" Error count: $count"
ourObj @ ".debug/errcount" getprop intostr "$count" subst Tell
ourObj @ ".debug/lastcrash" getprop if
" Last crash: %C %r"
ourObj @ ".debug/lastcrash" getprop timefmt Tell
else
" Last crash:" Tell
then
ourObj @ ".debug/lasterr" getpropstr if
" Last error: $error"
ourObj @ ".debug/lasterr" getprop
dup "), " instr strcut swap pop strip
1 strcut swap pop strip
"$error" subst Tell
else
" Last error:" Tell
then
ourObj @ ".debug/lastuser" getprop if
" User: $user"
ourObj @ ".debug/lastuser" getprop name "$user" subst Tell
then
;
: main
"me" match me !
dup if
"~&track&~" over smatch if DoTrack exit then
dup "#*" smatch if
dup " " instr if
dup " " instr strcut
strip ourArg !
strip ourOpt !
else
strip dup ourOpt ! ourArg !
then
"#help" ourOpt @ stringpfx if DoHelp else
"#all" ourOpt @ stringpfx if DoAll else
"#clear" ourOpt @ stringpfx if DoClear else
"#track" ourOpt @ stringpfx if DoSetTrack else
"#!track" ourOpt @ stringpfx if DoNoTrack else
ourOpt @ ourArg ! DoCheck
then then then then then
else
ourArg ! DoCheck
then
else
ourArg ! DoCheck
then
;
.
c
q