home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Club Amiga de Montreal - CAM
/
CAM_CD_1.iso
/
files
/
230.lha
/
SPY
/
Sources
/
Spy.Mod
< prev
next >
Wrap
Text File
|
1989-04-08
|
16KB
|
539 lines
MODULE Spy;
(************************************************)
(* Spy - A Task Control Block Snooper *)
(* *)
(* Written by Steve Faiwiszewski, June 1988 *)
(* *)
(* Not to be used for commercial purpose *)
(************************************************)
FROM Termination IMPORT ExitGracefully, AddTerminator;
FROM Snoop IMPORT WINDOWLEFT, WINDOWTOP, WIDTH,
HEIGHT, SpyWindow, Observe;
FROM Nodes IMPORT Node, NodePtr, NTProcess;
FROM Heap IMPORT ALLOCATE, FreeHeap;
FROM TermInOut IMPORT WriteLn, WriteString, WriteCard,
Write, WriteHex;
FROM Strings IMPORT StringLength;
FROM Tasks IMPORT Task, TaskPtr, CurrentTask,
TaskState, FindTask, SignalSet, Wait;
FROM Interrupts IMPORT Forbid, Permit;
FROM Rasters IMPORT Jam1, Jam2, RastPortPtr;
FROM System IMPORT argc, argv, ExecBase;
FROM ExecBase IMPORT ExecBasePtr;
FROM Ports IMPORT MsgPortPtr, MessagePtr, GetMsg,
ReplyMsg, WaitPort;
FROM Text IMPORT Text;
FROM Drawing IMPORT Move, Draw, SetAPen, SetBPen,
WritePixel, RectFill, SetDrMd;
FROM Intuition IMPORT WindowFlags, WindowFlagsSet,
IDCMPFlagsSet, IDCMPFlags,
GadgetActivation,
WindowPtr, CloseWindow, RemoveGadget,
GadgetPtr, PropInfoPtr, ModifyIDCMP,
IntuiMessagePtr, DoubleClick;
FROM SYSTEM IMPORT ADDRESS, ADR, WORD, LONGWORD, BYTE,
TSIZE;
FROM IntuiCommon
IMPORT OpenSimpleWindow;
FROM Conversions
IMPORT ConvStringToNumber;
FROM AmigaDOSProcess
IMPORT ProcessPtr;
FROM AmigaDOSExt
IMPORT CommandLineInterfacePtr;
FROM InputEvents
IMPORT IECodeLButton;
FROM SimpleGadgets
IMPORT BeginGadgetList, EndGadgetList,
LastGadget, AddGadgetProp,
FreeGadgetList;
CONST
PROPLEFT = 280;
PROPTOP = 10;
PROPWIDTH = WIDTH - PROPLEFT;
PROPHEIGHT = HEIGHT - PROPTOP - 1;
LetterHeight = 9;
LetterWidth = 8;
MaxNameLength = (PROPLEFT DIV LetterWidth) - 1;
MaxDisplayLines = PROPHEIGHT DIV LetterHeight;
TYPE
MyNodePtr = POINTER TO MyNode;
MyNode = RECORD
address : ADDRESS;
next : MyNodePtr;
END;
VAR
TargetTask : TaskPtr;
ExecBaseP : ExecBasePtr;
MyGadList : GadgetPtr;
PIptr : PropInfoPtr;
Divisor : CARDINAL;
PreviousSelectedLine : CARDINAL;
PreviousSelectedItemPtr : MyNodePtr;
Blanks : ARRAY[0..MaxNameLength-1] OF CHAR;
CloseTheWindow : BOOLEAN;
(* +++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
PROCEDURE CopyList(n : NodePtr; VAR tail : MyNodePtr;
VAR count : CARDINAL): MyNodePtr;
(* make a copy of the list while multitasking is FORBIDen *)
VAR
tmp,
head : MyNodePtr;
BEGIN
head := NIL;
tail := NIL;
WHILE (n <> NIL) AND (n^.lnSucc <> NIL) DO
INC(count);
ALLOCATE(tmp,TSIZE(MyNode));
WITH tmp^ DO
address := n;
next := head;
END;
head := tmp;
IF tail = NIL THEN tail := tmp END;
n := n^.lnSucc;
END; (* while n <> NIL *)
RETURN head
END CopyList;
(* +++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
PROCEDURE BuildTaskList(VAR total : CARDINAL) : MyNodePtr;
(* Build a list of all the tasks on the system *)
VAR
tail,
tail2,
tmp,
MyTaskList : MyNodePtr;
BEGIN
Forbid;
total := 0;
MyTaskList := NIL;
WITH ExecBaseP^ DO
(* First get all the "ready" tasks *)
MyTaskList := CopyList(TaskReady.lhHead,tail,total);
(* Now get all the "waiting" tasks *)
tmp := CopyList(TaskWait.lhHead,tail2,total);
IF MyTaskList = NIL THEN
MyTaskList := tmp
ELSE
tail^.next := tmp
END
END;
Permit;
RETURN MyTaskList;
END BuildTaskList;
(* +++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
PROCEDURE VerifyTaskIsReal(TargetTask : ADDRESS) : BOOLEAN;
(* Make sure that the task we'll be trying to spy on is *)
(* a real one (i.e. it's not a bogus address and the task *)
(* hasn't disappeared on us. *)
VAR
t : MyNodePtr;
found : BOOLEAN;
total : CARDINAL;
BEGIN
t := BuildTaskList(total);
found := FALSE;
WHILE (t <> NIL) AND NOT found DO
found := t^.address = TargetTask;
t := t^.next
END;
FreeHeap;
RETURN found
END VerifyTaskIsReal;
(* +++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
PROCEDURE Min(x,y : CARDINAL): CARDINAL;
BEGIN
IF x > y THEN RETURN y ELSE RETURN x END
END Min;
(* +++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
PROCEDURE Len(s : ADDRESS) : CARDINAL;
(* Calculate the length of a string pointed to by s *)
VAR cp : POINTER TO CHAR;
i : CARDINAL;
BEGIN
cp := s;
i := 0;
WHILE cp^ <> 0C DO
INC(i);
cp := ADDRESS(LONGCARD(cp) + 1D);
END;
RETURN i
END Len;
(* +++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
PROCEDURE PrintTaskName(RP : RastPortPtr; t : MyNodePtr;
line, APen, BPen : CARDINAL);
(* Print a task's name. If it also happens to be a process *)
(* then print the process (command) name instead. *)
VAR
tp : TaskPtr;
pp : ProcessPtr;
CliPtr : CommandLineInterfacePtr;
NameP : POINTER TO CHAR;
y,len : CARDINAL;
BEGIN
tp := t^.address;
NameP := tp^.tcNode.lnName;
IF CHAR(tp^.tcNode.lnType) = CHAR(NTProcess) THEN
pp := ProcessPtr(tp);
IF pp^.prCLI <> NIL THEN
CliPtr := ADDRESS(LONGCARD(pp^.prCLI)*4D);
NameP :=
ADDRESS(LONGCARD(CliPtr^.cliCommandName)*4D);
IF NameP^ = 0C THEN
NameP := ADR('(No Command)')
ELSE
NameP := ADDRESS(LONGCARD(NameP) + 1D)
END;
END
END;
y := 10 + line * LetterHeight;
SetAPen(RP^,0); SetBPen(RP^,0);
RectFill(RP^,5,y,PROPLEFT-2,y+LetterHeight);
SetAPen(RP^,APen);
SetBPen(RP^,BPen);
Move(RP^,5,y + LetterHeight - 2);
len := Len(NameP);
IF len > MaxNameLength THEN len := MaxNameLength END;
Text(RP^,NameP,len);
Text(RP^,ADR(Blanks),MaxNameLength - len);
END PrintTaskName;
(* +++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
PROCEDURE CleanUp;
VAR i : INTEGER;
BEGIN
IF CloseTheWindow AND (SpyWindow <> NIL) THEN
CloseWindow(SpyWindow^);
SpyWindow := NIL
END;
IF SpyWindow <> NIL THEN
i := RemoveGadget(SpyWindow^,MyGadList^);
END;
IF MyGadList <> NIL THEN
FreeGadgetList(MyGadList^);
MyGadList := NIL
END;
FreeHeap;
END CleanUp;
(* +++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
PROCEDURE CalculateTaskFromItem(item : CARDINAL;
TaskList : MyNodePtr): ADDRESS;
(* Find out which task corresponds to position number `item' *)
VAR
t : MyNodePtr;
i : CARDINAL;
BEGIN
t := TaskList;
FOR i := 1 TO item-1 DO
t := t^.next
END;
RETURN t^.address
END CalculateTaskFromItem;
(* +++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
PROCEDURE SelectItem(item, FirstItem : CARDINAL;
RP : RastPortPtr; TaskList : MyNodePtr);
(* Highlight the name of the task the user just clicked on *)
VAR
i,
line : CARDINAL;
t : MyNodePtr;
BEGIN
IF PreviousSelectedItemPtr <> NIL THEN
PrintTaskName(RP,PreviousSelectedItemPtr,
PreviousSelectedLine,1,0);
END;
line := item - FirstItem;
t := TaskList;
FOR i := 1 TO item-1 DO
t := t^.next
END;
PrintTaskName(RP,t,line,0,1);
PreviousSelectedItemPtr := t;
PreviousSelectedLine := line;
END SelectItem;
(* +++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
PROCEDURE CalculateFirstItem(TotalTasks : CARDINAL) : CARDINAL;
(* Calculate which task is the first on the display *)
VAR FirstItem : CARDINAL;
BEGIN
FirstItem := PIptr^.VertPot DIV Divisor + 1;
IF FirstItem > (TotalTasks + 1 - MaxDisplayLines) THEN
FirstItem := TotalTasks + 1 - MaxDisplayLines
END;
RETURN FirstItem
END CalculateFirstItem;
(* +++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
PROCEDURE OpenTaskWindow(VAR Divisor : CARDINAL;
VAR MyProp : GadgetPtr;
VAR PIptr : PropInfoPtr): SignalSet;
VAR
i : CARDINAL;
BEGIN
FOR i := 0 TO MaxNameLength - 1 DO Blanks[i] := ' ' END;
BeginGadgetList;
AddGadgetProp(PROPLEFT,PROPTOP,PROPWIDTH,PROPHEIGHT,
FALSE,TRUE,1,1,1,Divisor);
MyProp := LastGadget;
(* Add GadgImmediate so we get GadgetDown event *)
INCL(MyProp^.Activation,GadgImmediate);
PIptr := MyProp^.SpecialInfo;
MyGadList := EndGadgetList();
SpyWindow := OpenSimpleWindow(WIDTH,HEIGHT,WINDOWLEFT,
WINDOWTOP,
ADR('Snoop: List of Tasks'),
WindowFlagsSet{Activate,WindowDrag,
WindowDepth,WindowClose, NoCareRefresh},
IDCMPFlagsSet{MouseButtons,GadgetDown,
GadgetUp,Closewindow},
MyGadList,NIL);
SetAPen(SpyWindow^.RPort^,1);
SetDrMd(SpyWindow^.RPort^,Jam2);
RETURN SignalSet{CARDINAL(SpyWindow^.UserPort^.mpSigBit)};
END OpenTaskWindow;
(* +++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
PROCEDURE GetTaskFromUser(VAR task : ADDRESS) : BOOLEAN;
(* Display the list of tasks that are currently in the *)
(* system. *)
(* Wait for the user to either choose one task, or to *)
(* exit. *)
VAR
sig,
MySig : SignalSet;
msg : IntuiMessagePtr;
PreviousSecs,
PreviousMicros : LONGCARD;
MyProp : GadgetPtr;
good,
done : BOOLEAN;
TotalTasks,
FirstItem,
PreviousItem : CARDINAL;
TaskList : MyNodePtr;
(* ------------------------------- *)
PROCEDURE NeedUpdate() : BOOLEAN;
(* Check if display needs to be refreshed *)
VAR NewFirstItem : CARDINAL;
BEGIN
IF TotalTasks <= MaxDisplayLines THEN RETURN FALSE END;
NewFirstItem := CalculateFirstItem(TotalTasks);
IF NewFirstItem = FirstItem THEN
RETURN FALSE
ELSE
RETURN TRUE
END
END NeedUpdate;
(* ------------------------------- *)
PROCEDURE DisplayIt(RP : RastPortPtr);
(* Display the list of tasks *)
VAR
t : MyNodePtr;
i,
LastItem : CARDINAL;
BEGIN
PreviousSelectedItemPtr := NIL;
IF TotalTasks <= MaxDisplayLines THEN
FirstItem := 1
ELSE
FirstItem := CalculateFirstItem(TotalTasks)
END;
LastItem := Min(FirstItem + MaxDisplayLines - 1,
TotalTasks);
t := TaskList;
FOR i := 1 TO FirstItem-1 DO
IF t <> NIL THEN t := t^.next END
END;
FOR i := FirstItem TO LastItem DO
IF t = NIL THEN RETURN END;
PrintTaskName(RP,t,(i - FirstItem),1,0);
t := t^.next
END;
END DisplayIt;
(* ------------------------------- *)
PROCEDURE CalcItem(x,y : INTEGER): CARDINAL;
(* Find out which task was selected. *)
(* Return the task's position number in the list of tasks. *)
VAR item : CARDINAL;
BEGIN
item := CARDINAL(y + 1 - LetterHeight) DIV LetterHeight;
IF item > (MaxDisplayLines - 1) THEN
item := MaxDisplayLines - 1
END;
IF item <= TotalTasks THEN
RETURN item
ELSE
RETURN 0
END
END CalcItem;
(* ------------------------------- *)
PROCEDURE ProcessIntuiMsgs(msg : IntuiMessagePtr;
VAR done, good : BOOLEAN);
VAR
item : CARDINAL;
secs,
micros : LONGCARD;
address : ADDRESS;
class : IDCMPFlagsSet;
code : CARDINAL;
mx,my : INTEGER;
BEGIN
WITH msg^ DO
class := Class;
address := IAddress;
code := Code;
mx := MouseX;
my := MouseY;
secs := Seconds;
micros := Micros;
ReplyMsg(msg)
END; (* with *)
IF Closewindow IN class THEN (* User wants out *)
done := TRUE
ELSIF GadgetDown IN class THEN
IF (address = MyProp) AND
(TotalTasks > MaxDisplayLines) THEN
(* User clicked on slider, so start listening to IntuiTicks *)
ModifyIDCMP(SpyWindow^, SpyWindow^.IDCMPFlags +
IDCMPFlagsSet{IntuiTicks})
END
ELSIF GadgetUp IN class THEN
IF address = MyProp THEN
(* User released slider, so stop listening to IntuiTicks *)
ModifyIDCMP(SpyWindow^, SpyWindow^.IDCMPFlags -
IDCMPFlagsSet{IntuiTicks})
END
ELSIF IntuiTicks IN class THEN
(* Got a clock tick, so check if we need to refresh display *)
IF NeedUpdate() THEN
DisplayIt(SpyWindow^.RPort)
END
ELSIF MouseButtons IN class THEN
IF code = IECodeLButton THEN
item := CalcItem(mx,my) + 1;
item := FirstItem + item - 1;
IF (PreviousItem = item) AND
DoubleClick(PreviousSecs,PreviousMicros,
secs,micros) THEN
(* User picked a task to spy on *)
task := CalculateTaskFromItem(item,TaskList);
done := TRUE;
good := TRUE
ELSE
(* User is thinking about spying on a task, *)
(* so let's highlight it *)
PreviousItem := item;
PreviousSecs := secs;
PreviousMicros := micros;
SelectItem(item,FirstItem,SpyWindow^.RPort,
TaskList)
END (* if PreviousItem ... *)
END (* if code = IECodeLButton *)
END;
END ProcessIntuiMsgs;
(* ------------------------------- *)
BEGIN (* GetTaskFromUser *)
PreviousSelectedItemPtr := NIL;
good := FALSE;
done := FALSE;
TaskList := BuildTaskList(TotalTasks);
IF TotalTasks <= MaxDisplayLines THEN
Divisor := 0FFFFH
ELSE
Divisor := 0FFFFH DIV (1+ TotalTasks - MaxDisplayLines)
END;
MySig := OpenTaskWindow(Divisor,MyProp,PIptr);
DisplayIt(SpyWindow^.RPort);
REPEAT
sig := Wait(MySig);
msg := GetMsg(SpyWindow^.UserPort^);
WHILE (msg <> NIL) DO
ProcessIntuiMsgs(msg,done,good);
msg := GetMsg(SpyWindow^.UserPort^);
END; (* while *)
UNTIL done;
CloseTheWindow := FALSE;
CleanUp;
CloseTheWindow := TRUE;
RETURN good
END GetTaskFromUser;
(* +++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
PROCEDURE Main;
VAR
good : BOOLEAN;
Myself : TaskPtr;
BEGIN
Myself := FindTask(CurrentTask);
IF argc < 2 THEN
good := GetTaskFromUser(TargetTask);
ELSIF argc > 2 THEN
WriteString('Format: ');
WriteString(argv^[0]^);
WriteString(
' xxxx\nwhere xxxx is the hex address of a task\n');
good := FALSE
ELSE
good := ConvStringToNumber(argv^[1]^, TargetTask,
FALSE, 16);
IF NOT good THEN
WriteString('Invalid data in address field!\n')
ELSIF LONGCARD(TargetTask) MOD 4D <> 0D THEN
WriteString('Invalid address!\n');
good := FALSE;
ELSIF TargetTask = Myself THEN
WriteString("Can't snoop on myself!!\n");
good := FALSE;
END;
END;
IF good THEN good := VerifyTaskIsReal(TargetTask) END;
IF good THEN
Observe(TargetTask)
END;
END Main;
(* +++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
BEGIN
ExecBaseP := ExecBase;
CloseTheWindow := TRUE;
SpyWindow := NIL;
MyGadList := NIL;
AddTerminator(CleanUp);
Main;
ExitGracefully(0)
END Spy.