Club Amiga de Montreal - CAM/CAM_CD_1.iso/files/230.lha/SPY/Sources/Spy.Mod

Text File | 1989-04-08 | 15.9 KB | 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.