DIRECTORY
Atom USING [GetPName],
Basics USING [bytesPerWord],
BasicTime USING [GMT, Now, nullGMT, Period],
Buttons USING [Button, ButtonProc, Create, SetDisplayStyle],
Checksum USING [ComputeChecksum],
Commander USING [CommandProc, Register],
Containers USING [ChildXBound, ChildYBound, Create],
Convert USING [Error, IntFromRope, RopeFromInt],
IO USING [Close, CreateStream, CreateStreamProcs, Flush, PutF, STREAM, StreamProcs],
Labels USING [Create],
Loader USING [BCDBuildTime],
Rope USING [ROPE],
Rules USING [Create],
SafeStorage USING [NWordsAllocated],
STP USING [CompletionProcType, ConfirmProcType, Close, Create, DesiredProperties, Error, GetProperty, Handle, Login, Open, Retrieve, SetDesiredProperties],
TypeScript USING [ChangeLooks, Create],
UserCredentials USING [Get],
VFonts USING [FontHeight, StringWidth],
ViewerClasses USING [Viewer],
ViewerEvents USING [EventProc, RegisterEventProc],
ViewerIO USING [CreateViewerStreams],
ViewerOps USING [AddProp, ComputeColumn, CreateViewer, FetchProp, MoveViewer, OpenIcon, SetOpenHeight],
ViewerTools USING [GetContents, MakeNewTextViewer, SetContents, SetSelection];
Checksummer:
CEDAR
MONITOR
IMPORTS
Atom, BasicTime, Buttons, Checksum, Commander, Containers, Convert, IO, Labels, Loader, Rules, SafeStorage, STP, TypeScript, UserCredentials, VFonts, ViewerEvents, ViewerIO, ViewerOps, ViewerTools =
BEGIN
BYTE: TYPE = [0..100H);
ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
Viewer: TYPE = ViewerClasses.Viewer;
Viewer layout parameters
buttonHeight: INT ← VFonts.FontHeight[] + 3;
buttonWidth: INT ← VFonts.StringWidth["WrDsk"] + 2*3;
ClientData: TYPE = REF ClientDataRep;
ClientDataRep:
TYPE =
RECORD [
log: STREAM ← NIL,
in: STREAM ← NIL,
pleaseStop: BOOLEAN ← FALSE,
user: PROCESS ← NIL,
silent: REF BOOL ← NEW[BOOL ← FALSE],
version: REF BOOL ← NEW[BOOL ← TRUE],
host, files: Viewer ← NIL ];
global: ClientData ← NIL; -- debugging
Create: Commander.CommandProc = {
viewer, buttons, log: Viewer ← NIL;
data: ClientData ← NEW[ClientDataRep ← []];
global ← data;
viewer ← ViewerOps.CreateViewer [
flavor: $Container,
info: [name: "Checksummer", column: right, iconic: TRUE, scrollable: FALSE]];
[] ← ViewerEvents.RegisterEventProc[Poof, destroy, viewer, TRUE];
ViewerOps.AddProp[viewer, $Checksummer, data];
log ← TypeScript.Create[
[name: "Checksummer.log", wy: 27+4, parent: viewer, border: FALSE], FALSE];
[data.in, data.log] ← ViewerIO.CreateViewerStreams [
name: "Checksummer.log", backingFile: "Checksummer.log", viewer: log, editedStream: FALSE];
Containers.ChildXBound[viewer, log];
Containers.ChildYBound[viewer, log];
CreateButtons[data, viewer, log];
TypeScript.ChangeLooks[log, 'f];
IO.PutF[data.log, "Checksummer of %G.\n\n", [time[Loader.BCDBuildTime[Create]]]];
ViewerOps.OpenIcon[viewer]; };
CreateButtons:
ENTRY
PROC[data: ClientData, parent, log: Viewer] = {
child: Viewer ← NIL;
kids: Viewer = Containers.Create[
info: [parent: parent, border: FALSE, scrollable: FALSE, wx: 0, wy: -9999, ww: 9999, wh: 0] ];
Containers.ChildXBound[parent, kids];
child ← MakeRule[kids, child];
child ← data.host ← MakeLabeledText[
parent: kids,
sibling: child,
name: "Host:",
data: "Host",
width: VFonts.StringWidth["xxxxxxxxxxxxxxx"],
prev: data.host ];
Containers.ChildXBound[parent, child];
child ← data.files ← MakeLabeledText[
parent: kids,
sibling: child,
name: "Files:",
data: "Files",
width: 9*VFonts.StringWidth["Big long file name ..........................."],
prev: data.files ];
Containers.ChildXBound[parent, child];
child ← MakeRule[kids, child];
child ← MakeBool[name: "Version", init: data.version, clientData: data, parent: kids, x: 2, y: child.wy+child.wh+1];
child ← MakeBool[name: "Silent", init: data.silent, clientData: data, parent: kids, x: child.wx + child.ww + 10, y: child.wy];
child ← MakeRule[kids, child];
child ← MakeLabel[kids, child, "What: "];
child ← MakeButton[kids, child, data, "Stop", StopProc];
child ← MakeButton[kids, child, data, "Check", CheckProc];
child ← MakeRule[kids, child];
{
kidsY: INTEGER = 2;
kidsH: INTEGER = child.wy + child.wh + 2;
ViewerOps.MoveViewer[viewer: log, x: 0, y: kidsY + kidsH, w: log.ww, h: parent.ch - (kids.wy + kidsH), paint: FALSE];
ViewerOps.SetOpenHeight[parent, kidsY + kidsH + 12 * buttonHeight];
IF ~parent.iconic THEN ViewerOps.ComputeColumn[parent.column];
ViewerOps.MoveViewer[viewer: kids, x: kids.wx, y: kidsY, w: kids.ww, h: kidsH]; };
};
Poof: ViewerEvents.EventProc = {
[viewer: ViewerClasses.Viewer, event: ViewerEvent, before: BOOL]
RETURNS[abort: BOOL ← FALSE]
data: ClientData ← NARROW[ViewerOps.FetchProp[viewer, $Checksummer]];
IF event # destroy OR before # TRUE THEN ERROR;
Stop[data];
IO.Close[data.log];
IO.Close[data.in];
};
StopProc: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
data: ClientData ← NARROW[clientData];
Stop[data]; };
Stop:
PROC [data: ClientData] =
TRUSTED {
data.pleaseStop ← TRUE;
IF data.user # NIL THEN JOIN data.user;
data.user ← NIL; };
CheckProc: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
data: ClientData ← NARROW[clientData];
data.pleaseStop ← FALSE;
Check[data]; };
streamProcs:
REF
IO.StreamProcs =
IO.CreateStreamProcs[
variety: $output,
class: $Checksummer,
putBlock: PutBlock,
close: Close ];
StreamData: TYPE = REF StreamDataRep;
StreamDataRep:
TYPE =
RECORD [
data: ClientData,
fileName: ROPE,
sizeRope: ROPE,
createRope: ROPE,
stream: STREAM,
size: INT,
create: BasicTime.GMT,
bytes: INT,
checksum: WORD ];
Words:
PROC [bytes:
NAT]
RETURNS [words:
NAT] = {
RETURN[(bytes+Basics.bytesPerWord-1)/Basics.bytesPerWord];
};
PutBlock:
PROC [self:
STREAM, block:
REF
READONLY
TEXT, startIndex:
NAT, count:
NAT] = {
me: StreamData = NARROW[self.streamData];
base: LONG POINTER = LOOPHOLE[block, LONG POINTER]+TEXT[0].SIZE;
bytes: LONG POINTER TO PACKED ARRAY [0..NAT.LAST] OF CHAR = LOOPHOLE[base];
IF startIndex # 0 THEN ERROR;
count ← MIN[count, block.length];
me.bytes ← me.bytes + count;
IF (count MOD 2) # 0 THEN TRUSTED { bytes[count] ← 0C; };
TRUSTED {
me.checksum ← Checksum.ComputeChecksum[me.checksum, Words[count], base]; };
};
Close:
PROC [self:
STREAM, abort:
BOOL] = {
me: StreamData = NARROW[self.streamData];
data: ClientData ← me.data;
IF ~data.silent^
OR (me.size # me.bytes)
THEN {
checksumRope: ROPE ← Convert.RopeFromInt[me.checksum, 16, FALSE];
IO.PutF[
data.log,
"%8G %4G %G %G.\n",
[integer[me.size]],
[rope[checksumRope]],
[rope[me.createRope]],
[rope[me.fileName]] ]; };
IF me.size # me.bytes
THEN
IO.PutF[
data.log,
"***** Length mixup. Expected %g bytes, got %G.\n",
[integer[me.size]],
[integer[me.bytes]] ];
};
Check:
PROC [data: ClientData] = {
me: StreamData ←
NEW[StreamDataRep ← [
data: data,
fileName: NIL,
sizeRope: NIL,
createRope: NIL,
size: 0,
create: BasicTime.nullGMT,
bytes: 0,
checksum: 0 ]];
stream: IO.STREAM ← IO.CreateStream[streamProcs: streamProcs, streamData: me];
Open:
STP.ConfirmProcType = {
me^ ← [
data: data,
fileName: file,
sizeRope: STP.GetProperty[stp, size],
createRope: STP.GetProperty[stp, createDate],
size: 0,
create: BasicTime.nullGMT,
bytes: 0,
checksum: 0 ];
IF data.pleaseStop THEN RETURN[abort, NIL];
me.size ← Convert.IntFromRope[me.sizeRope ! Convert.Error => CONTINUE];
RETURN[do, stream];
};
Close:
STP.CompletionProcType = {
me: StreamData = NARROW[stream.streamData];
totalBytes ← totalBytes + me.bytes;
totalFiles ← totalFiles + 1;
SELECT what
FROM
ok => IO.Close[stream];
error => IO.PutF[data.log, "***** STP Says error: %G while processing %G.\n", [rope[fileOrError]], [rope[me.fileName]] ];
ENDCASE => ERROR;
};
start: BasicTime.GMT ← BasicTime.Now[];
stop: BasicTime.GMT;
seconds: INT;
words: INT ← SafeStorage.NWordsAllocated[];
host: ROPE = ViewerTools.GetContents[data.host];
files: ROPE = ViewerTools.GetContents[data.files];
stp: STP.Handle ← STP.Create[];
herald, name, password: ROPE;
failed: BOOL ← FALSE;
totalBytes: INT ← 0;
totalFiles: INT ← 0;
desiredProperties: STP.DesiredProperties ← ALL[FALSE];
desiredProperties[size] ← TRUE;
desiredProperties[createDate] ← TRUE;
desiredProperties[directory] ← TRUE;
desiredProperties[nameBody] ← TRUE;
desiredProperties[version] ← data.version^;
IO.PutF[
data.log,
"\n%G Scanning %G on %G.\n\n",
[time[BasicTime.Now[]]],
[rope[files]],
[rope[host]] ];
herald ←
STP.Open[stp, host !
STP.Error => {
IO.PutF[data.log, " STP Open failed: %G.\n", [rope[error]] ];
failed ← TRUE;
CONTINUE }];
IF failed THEN RETURN;
[name, password] ← UserCredentials.Get[];
STP.Login[stp, name, password];
STP.SetDesiredProperties[stp, desiredProperties];
STP.Retrieve[stp, files, Open, Close !
STP.Error => {
IO.PutF[data.log, " STP Retrieve failed: %G.\n", [rope[error]] ];
CONTINUE }];
STP.Close[stp ! STP.Error => CONTINUE ];
stop ← BasicTime.Now[];
seconds ← BasicTime.Period[from: start, to: stop];
seconds ← MAX[seconds, 1];
words ← SafeStorage.NWordsAllocated[]-words;
IO.PutF[
data.log,
"\nScanned %G files containing %G bytes in %R => %3.1FK bits/second.\n",
[integer[totalFiles]],
[integer[totalBytes]],
[integer[seconds]],
[real[(REAL[totalBytes]*8)/seconds/1000]] ];
IO.PutF[
data.log,
"Used %G words => %G words/file or %G words/second.\n",
[integer[words]],
[integer[words/totalFiles]],
[integer[words/seconds]] ];
IO.Flush[data.log];
};
MakeRule:
PROC [parent, sibling: Viewer]
RETURNS [child: Viewer] = {
child ← Rules.Create[
info: [parent: parent, border:
FALSE,
wy: IF sibling = NIL THEN 0 ELSE sibling.wy + sibling.wh + 2, wx: 0, ww: parent.ww, wh: 1],
paint: FALSE ];
Containers.ChildXBound[parent, child];
};
MakeButton:
PROC [parent, sibling: Viewer, data:
REF
ANY, name:
ROPE, proc: Buttons.ButtonProc]
RETURNS[child: Viewer] = {
child ← Buttons.Create[
info: [name: name, parent: parent, border:
TRUE,
wy: sibling.wy, wx: sibling.wx + sibling.ww - 1, ww: buttonWidth],
proc: proc,
clientData: data,
fork: TRUE,
paint: FALSE];
};
SelectorProc: TYPE = PROC [parent: Viewer, clientData: REF, value: ATOM];
Selector: TYPE = REF SelectorRec;
SelectorRec:
TYPE =
RECORD [
value: REF ATOM,
change: PROC [parent: Viewer, clientData: REF, value: ATOM],
clientData: REF,
buttons: LIST OF Buttons.Button,
values: LIST OF ATOM ];
MakeSelector:
PROC
[name: ROPE, values: LIST OF ATOM, init: REF ATOM ← NIL, change: SelectorProc ← NIL, clientData: REF ← NIL, parent: Viewer, x, y: INTEGER]
RETURNS [child: Viewer] = {
selector: Selector ←
NEW [SelectorRec ← [
value: IF init # NIL THEN init ELSE NEW [ATOM ← values.first],
change: change,
clientData: clientData,
buttons: NIL,
values: values ] ];
last: LIST OF Buttons.Button ← NIL;
child ← Labels.Create[info: [name: name, parent: parent, border: FALSE, wx: x, wy: y] ];
FOR a:
LIST
OF
ATOM ← values, a.rest
UNTIL a =
NIL
DO
child ← Buttons.Create[
info: [name: Atom.GetPName[a.first], parent: parent, border: TRUE, wx: child.wx + child.ww + 2, wy: child.wy],
proc: SelectorHelper, clientData: selector, fork: TRUE, paint: TRUE];
IF last = NIL THEN last ← selector.buttons ← CONS[first: child, rest: NIL]
ELSE { last.rest ← CONS[first: child, rest: NIL]; last ← last.rest };
IF a.first = selector.value^ THEN Buttons.SetDisplayStyle[child, $WhiteOnBlack];
ENDLOOP; };
SelectorHelper: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
self: Buttons.Button = NARROW[parent];
selector: Selector = NARROW[clientData];
buttons: LIST OF Buttons.Button ← selector.buttons;
FOR a:
LIST
OF
ATOM ← selector.values, a.rest
UNTIL a =
NIL
DO
IF self = buttons.first
THEN {
selector.value^ ← a.first;
IF selector.change # NIL THEN selector.change[self.parent, selector.clientData, a.first];
Buttons.SetDisplayStyle[buttons.first, $WhiteOnBlack]; }
ELSE Buttons.SetDisplayStyle[buttons.first, $BlackOnWhite];
buttons ← buttons.rest;
ENDLOOP; };
BoolProc: TYPE = PROC [parent: Viewer, clientData: REF, value: BOOL];
Bool: TYPE = REF BoolRec;
BoolRec:
TYPE =
RECORD [
value: REF BOOL,
change: BoolProc,
clientData: REF,
button: Viewer ];
MakeBool:
PROC
[name: ROPE, init: REF BOOL, change: BoolProc ← NIL, clientData: REF ← NIL, parent: Viewer, x, y: INTEGER]
RETURNS [child: Viewer] = {
bool: Bool ←
NEW [BoolRec ← [
value: IF init # NIL THEN init ELSE NEW [BOOL ← TRUE],
change: change,
clientData: clientData,
button: NIL ] ];
child ← Buttons.Create[
info: [name: name, parent: parent, border: TRUE, wx: x, wy: y],
proc: BoolHelper, clientData: bool, fork: TRUE, paint: TRUE];
bool.button ← child;
IF bool.value^ THEN Buttons.SetDisplayStyle[child, $WhiteOnBlack]; };
BoolHelper: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
self: Buttons.Button = NARROW[parent];
bool: Bool = NARROW[clientData];
bool.value^ ← ~bool.value^;
IF bool.value^ THEN Buttons.SetDisplayStyle[bool.button, $WhiteOnBlack]
ELSE Buttons.SetDisplayStyle[bool.button, $BlackOnWhite];
IF bool.change # NIL THEN bool.change[self.parent, bool.clientData, bool.value^]; };
MakeLabel:
PROC [parent, sibling: Viewer, name:
ROPE]
RETURNS [child: Viewer] = {
child ← Labels.Create[
info: [name: name, parent: parent, border:
FALSE,
wy: sibling.wy + sibling.wh + (IF sibling.class.flavor = $Button THEN -1 ELSE 2),
wx: 2,
ww: VFonts.StringWidth[name] + 2*3 + 2],
paint: FALSE ]; };
MakeLabeledText:
PROC [
parent, sibling: Viewer, name, data: ROPE, prev: Viewer, width: INT, newline: BOOL ← TRUE] RETURNS [child: Viewer] = {
buttonWidth: INT ← VFonts.StringWidth[name] + 2*3;
x: INTEGER = IF newline THEN 2 ELSE sibling.wx + sibling.ww + 10;
y: INTEGER = IF newline THEN sibling.wy + sibling.wh + 1 ELSE sibling.wy;
child ← ViewerTools.MakeNewTextViewer[
info: [
parent: parent, wh: buttonHeight, ww: width+10,
data: IF prev = NIL THEN data ELSE ViewerTools.GetContents[prev],
border: FALSE,
wx: x + buttonWidth + 2, wy: y,
scrollable: FALSE ],
paint: FALSE ];
[] ← Buttons.Create[
info: [name: name, parent: parent, wh: buttonHeight, border: FALSE, wx: x, wy: y],
proc: LabeledTextProc, clientData: child, fork: FALSE, paint: FALSE];
RETURN[child]; };
LabeledTextProc: Buttons.ButtonProc = {
parent: REF, clientData: REF, mouseButton: MouseButton, shift, control: BOOL
text: Viewer = NARROW[clientData];
SELECT mouseButton
FROM
red => ViewerTools.SetSelection[text, NIL];
yellow => NULL;
blue => { ViewerTools.SetContents[text, NIL]; ViewerTools.SetSelection[text, NIL] };
ENDCASE => ERROR; };
Commander.Register["Checksummer", Create, "Checksum remote files."];
END.