diff options
Diffstat (limited to 'system/multiuser/1.7.5/src/global manager')
-rw-r--r-- | system/multiuser/1.7.5/src/global manager | 683 |
1 files changed, 683 insertions, 0 deletions
diff --git a/system/multiuser/1.7.5/src/global manager b/system/multiuser/1.7.5/src/global manager new file mode 100644 index 0000000..b3d64cc --- /dev/null +++ b/system/multiuser/1.7.5/src/global manager @@ -0,0 +1,683 @@ +(* ------------------- VERSION 19 16.05.86 ------------------- *) +PACKET global manager DEFINES (* Autor: J.Liedtke *) + + ALL , + begin password , + call , + continue channel , + erase , + exists , + fetch , + free global manager , + free manager , + global manager , + list , + manager message , + manager question , + save , + std manager : + + +LET ack = 0 , + nak = 1 , + error nak = 2 , + message ack = 3 , + question ack = 4 , + second phase ack = 5 , + false code = 6 , + + begin code = 4 , + password code = 9 , + fetch code = 11 , + save code = 12 , + exists code = 13 , + erase code = 14 , + list code = 15 , + all code = 17 , + free code = 20 , + continue code = 100, + + + error pre = ""7""13""10""5"FEHLER : " , + cr lf = ""13""10"" ; + +INT VAR reply , order , last order, phase number ; + +DATASPACE VAR ds := nilspace ; + +BOUND STRUCT (TEXT name, write pass, read pass) VAR msg ; +BOUND TEXT VAR reply msg ; +BOUND THESAURUS VAR thesaurus msg ; + +TASK VAR order task, last order task ; + +FILE VAR list file ; + +TEXT VAR error message buffer := "" + ,record + ,received name + ,create son password := "" + ,save file name + ,save write password + ,save read password + ; + + +PROC fetch (TEXT CONST file name) : + + fetch (file name, father) + +ENDPROC fetch ; + +PROC fetch (TEXT CONST file name, TASK CONST manager) : + + enable stop ; + last param (file name) ; + IF NOT exists (file name) + THEN call (fetch code, file name, manager) + ELIF overwrite permitted + THEN call (fetch code, file name, manager) ; + forget (file name, quiet) + ELSE LEAVE fetch + FI ; + IF reply = ack + THEN disable stop ; + copy (ds, file name) ; + forget (ds) + ELSE forget (ds) ; + errorstop ("Task """ + name (manager) + """antwortet nicht mit ack") + FI . + +overwrite permitted : + say ("eigene Datei """) ; + say (file name) ; + yes (""" ueberschreiben") . + +ENDPROC fetch ; + +PROC fetch (DATASPACE VAR dest, TEXT CONST file name, TASK CONST manager) : + + disable stop ; + call (fetch code, file name, manager) ; + dest := ds ; + forget (ds) + +ENDPROC fetch ; + + +PROC save : + + save (last param) + +ENDPROC save ; + +PROC save (TEXT CONST file name) : + + save (file name, father) + +ENDPROC save ; + +PROC save (TEXT CONST file name, TASK CONST manager) : + + last param (file name) ; + call (save code, file name, old (file name), manager) ; + forget (ds) + +ENDPROC save ; + +PROC save (DATASPACE CONST source, TEXT CONST file name, TASK CONST manager): + + call (save code, file name, source, manager) ; + forget (ds) + +ENDPROC save ; + + +BOOL PROC exists (TEXT CONST file name, TASK CONST manager) : + + call (exists code, file name, manager) ; + forget (ds) ; + reply = ack . + +ENDPROC exists ; + + +PROC erase : + + erase (last param) + +ENDPROC erase ; + +PROC erase (TEXT CONST file name) : + + erase (file name, father) + +ENDPROC erase ; + +PROC erase (TEXT CONST file name, TASK CONST manager) : + + call (erase code, file name, manager) ; + forget (ds) + +ENDPROC erase ; + + +PROC list (TASK CONST manager) : + + IF manager = myself + THEN list + ELSE list from manager + FI . + +list from manager : + call (list code, "", manager) ; + IF reply = ack + THEN DATASPACE VAR save ds := ds ; + forget (ds) ; + list file := sequential file (modify, save ds) ; + insert station and name of task in headline if possible ; + show (list file) ; + forget (save ds) + ELSE forget (ds) + FI . + +insert station and name of task in headline if possible : + IF headline (list file) = "" + THEN headline (list file, station number if there is one + + " Task : " + name (manager)) + FI . + +station number if there is one : + IF station (manager) > 0 + THEN "Station : " + text (station (manager)) + ELSE "" + FI . + +ENDPROC list ; + +PROC list (FILE VAR f, TASK CONST manager) : + + IF manager = myself + THEN list (f) + ELSE list from manager + FI . + +list from manager : + call (list code, "", manager) ; + IF reply = ack + THEN DATASPACE VAR save ds := ds ; + forget (ds) ; + list file := sequential file (input, save ds) ; + copy attributes (list file, f) ; + insert station and name of task in headline if possible ; + REP + getline (list file, record) ; + putline (f, record) + UNTIL eof (list file) PER ; + forget (save ds) + ELSE forget (ds) + FI . + +insert station and name of task in headline if possible : + IF headline (list file) = "" + THEN headline (list file, station number if there is one + + " Task : " + name (manager)) + FI . + +station number if there is one : + IF station (manager) > 0 + THEN "Station : " + text (station (manager)) + ELSE "" + FI . + +ENDPROC list ; + +THESAURUS OP ALL (TASK CONST manager) : + + THESAURUS VAR result ; + IF manager = myself + THEN result := all + ELSE get all from manager + FI ; + result . + +get all from manager : + call (all code, "", manager) ; + IF reply = ack + THEN get result thesaurus + ELSE result := empty thesaurus + FI . + +get result thesaurus : + thesaurus msg := ds ; + result := CONCR (thesaurus msg) ; + forget (ds) . + +ENDOP ALL ; + + +PROC call (INT CONST op code, TEXT CONST file name, TASK CONST manager) : + + DATASPACE VAR dummy space ; + call (op code, file name, dummy space, manager) + +ENDPROC call ; + +PROC call (INT CONST op code, TEXT CONST file name, + DATASPACE CONST save space, TASK CONST manager) : + + enable stop ; + send first order first time ; + send second order if required first time ; + WHILE order restart required REP + pause (10) ; + send first order (op code, file name, manager) ; + send second order if required + PER ; + error or message if required . + +send first order first time : + send first order (op code, file name, manager) ; + WHILE order restart required REP + pause (10) ; + send first order (op code, file name, manager) + PER . + +send second order if required first time : + IF reply = question ack + THEN reply msg := ds ; + IF NOT yes (reply msg) + THEN LEAVE call + ELSE send second order (op code, file name, save space, manager) + FI + ELIF reply = second phase ack + THEN send second order (op code, file name, save space, manager) + FI . + +send second order if required : + IF reply = second phase ack OR reply = question ack + THEN send second order (op code, file name, save space, manager) + FI . + +error or message if required : + IF reply = message ack + THEN reply msg := ds ; + say (reply msg) ; + say (cr lf) + ELIF reply = error nak + THEN reply msg := ds ; + errorstop (reply msg) + FI . + +order restart required : reply = nak . + +ENDPROC call ; + +PROC send first order (INT CONST op code, TEXT CONST file name, + TASK CONST manager) : + + forget (ds) ; + ds := nilspace ; + msg := ds ; + msg.name := file name ; + msg.write pass := write password ; + msg.read pass := read password ; + call (manager, op code, ds, reply) ; + IF reply < 0 + THEN errorstop ("Task nicht vorhanden") + FI . + +ENDPROC send first order ; + +PROC send second order (INT CONST op code, TEXT CONST file name, + DATASPACE CONST save space, TASK CONST manager) : + + IF op code = save code + THEN send save space + ELSE send first order (second phase ack, file name, manager) + FI . + +send save space : + forget (ds) ; + ds := save space ; + call (manager, second phase ack, ds, reply) . + +ENDPROC send second order ; + + +PROC global manager : + + global manager + (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) std manager) + +ENDPROC global manager ; + +PROC free global manager : + + global manager + (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) free manager) + +ENDPROC free global manager ; + + +PROC global manager (PROC (DATASPACE VAR, + INT CONST, INT CONST, TASK CONST) manager) : + + DATASPACE VAR local ds := nilspace ; + break ; + set autonom ; + disable stop ; + command dialogue (FALSE) ; + remember heap size ; + last order task := niltask ; + REP + forget (local ds) ; + wait (local ds, order, order task) ; + IF order <> second phase ack + THEN prepare first phase ; + manager (local ds, order, phase number, order task) + ELIF order task = last order task + THEN prepare second phase ; + manager (local ds, order, phase number, order task) + ELSE send nak + FI ; + send error if necessary ; + collect heap garbage if necessary + PER . + +prepare first phase : + phase number := 1 ; + last order := order ; + last order task := order task . + +prepare second phase : + phase number INCR 1 ; + order := last order . + +send nak : + forget (local ds) ; + local ds := nilspace ; + send (order task, nak, local ds) . + +send error if necessary : + IF is error + THEN forget (local ds) ; + local ds := nilspace ; + reply msg := local ds ; + CONCR (reply msg) := error message ; + clear error ; + send (order task, error nak, local ds) + FI . + +remember heap size : + INT VAR old heap size := heap size . + +collect heap garbage if necessary : + IF heap size > old heap size + 8 + THEN collect heap garbage ; + old heap size := heap size + FI . + +ENDPROC global manager ; + +PROC std manager (DATASPACE VAR ds, + INT CONST order, phase, TASK CONST order task) : + + IF order task < myself OR order = begin code OR order task = supervisor + THEN free manager (ds, order, phase, order task) + ELSE errorstop ("kein Zugriffsrecht auf Task """ + name (myself) + """") + FI . + +ENDPROC std manager ; + +PROC free manager (DATASPACE VAR ds, + INT CONST order, phase, TASK CONST order task): + + enable stop ; + IF order > continue code AND + order task = supervisor THEN y maintenance + ELIF order = begin code THEN y begin + ELSE file manager order + FI . + +file manager order : + get message text if there is one ; + SELECT order OF + CASE fetch code : y fetch + CASE save code : y save + CASE exists code : y exists + CASE erase code : y erase + CASE list code : y list + CASE all code : y all + OTHERWISE errorstop ("falscher Auftrag fuer Task """+name(myself)+"""") + ENDSELECT . + +get message text if there is one : + IF order >= fetch code AND order <= erase code AND phase = 1 + THEN msg := ds ; + received name := msg.name + FI . + +y begin : + BOUND STRUCT (TEXT tname, tpass, TASK task, PROCA start proc) VAR sv msg := ds ; + IF create son password = sv msg.tpass AND create son password <> "-" + THEN create son task + ELIF sv msg.tpass = "" + THEN ask for password + ELSE errorstop ("Passwort falsch") + FI . + +create son task : + begin (ds, PROC std begin, reply) ; + send (order task, reply, ds) . + +ask for password : + send (order task, password code, ds) . + + +y fetch : + IF read permission (received name, msg.read pass) + THEN forget (ds) ; + ds := old (received name) ; + send (order task, ack, ds) + ELSE errorstop ("Passwort falsch") + FI . + +y erase : + msg := ds ; + received name := msg.name ; + IF NOT exists (received name) + THEN manager message ("""" + received name + """ existiert nicht", order task) + ELIF phase = 1 + THEN manager question ("""" + received name + """ loeschen", order task) + ELIF write permission (received name, msg.write pass) + THEN forget (received name, quiet) ; + send (order task, ack, ds) + ELSE errorstop ("Passwort falsch") + FI . + +y save : + IF phase = 1 + THEN y save pre + ELSE y save post + FI . + +y save pre : + IF write permission (received name, msg.write pass) + THEN save file name := received name ; + save write password := msg.write pass ; + save read password := msg.read pass ; + IF exists (received name) + THEN manager question + ("""" + received name + """ ueberschreiben", order task) + ELSE send (order task, second phase ack, ds) + FI + ELSE errorstop ("Passwort falsch") + FI . + +y save post : + forget (save file name, quiet) ; + copy (ds, save file name) ; + enter password (save file name, save write password, save read password) ; + forget (ds) ; + ds := nilspace ; + send (order task, ack, ds) ; + cover tracks of save passwords . + +cover tracks of save passwords : + replace (save write password, 1, LENGTH save write password * " ") ; + replace (save read password, 1, LENGTH save read password * " ") . + +y exists : + IF exists (received name) + THEN send (order task, ack, ds) + ELSE send (order task, false code, ds) + FI . + +y list : + forget (ds) ; + ds := nilspace ; + list file := sequential file (output, ds) ; + list (list file) ; + send (order task, ack, ds) . + +y all : + BOUND THESAURUS VAR all names := ds ; + all names := all ; + send (order task, ack, ds) . + +y maintenance : + disable stop ; + call (supervisor, order, ds, reply) ; + forget (ds) ; + IF reply = ack + THEN put error message if there is one ; + REP + command dialogue (TRUE) ; + get command ("maintenance :") ; + reset editor ; + do command + UNTIL NOT on line PER ; + command dialogue (FALSE) ; + break ; + set autonom ; + save error message if there is one + FI ; + enable stop . + +put error message if there is one : + IF error message buffer <> "" + THEN out (error pre) ; + out (error message buffer) ; + out (cr lf) ; + error message buffer := "" + FI . + +reset editor : + WHILE aktueller editor > 0 REP + quit + PER ; + clear error . + +save error message if there is one : + IF is error + THEN error message buffer := error message ; + clear error + FI . + +ENDPROC free manager ; + +PROC manager message (TEXT CONST message) : + + forget (ds) ; + ds := nilspace ; + reply msg := ds ; + reply msg := message ; + send (order task, message ack, ds) + +ENDPROC manager message ; + +PROC manager question (TEXT CONST question) : + + forget (ds) ; + ds := nilspace ; + reply msg := ds ; + reply msg := question ; + send (order task, question ack, ds) + +ENDPROC manager question ; + +PROC manager message (TEXT CONST message, TASK CONST receiver) : + + forget (ds) ; + ds := nilspace ; + reply msg := ds ; + reply msg := message ; + send (receiver, message ack, ds) + +ENDPROC manager message ; + +PROC manager question (TEXT CONST question, TASK CONST receiver) : + + forget (ds) ; + ds := nilspace ; + reply msg := ds ; + reply msg := question ; + send (receiver, question ack, ds) + +ENDPROC manager question ; + +PROC std begin : + + do ("monitor") + +ENDPROC std begin ; + +PROC begin password (TEXT CONST password) : + + cover tracks of old create son password ; + create son password := password ; + say (""3""13""5"") ; + cover tracks . + +cover tracks of old create son password : + replace (create son password, 1, LENGTH create son password * " ") . + +ENDPROC begin password ; + + +PROC continue channel (INT CONST channel number) : + + TASK CONST channel owner := task (channel number) ; + IF i am not channel owner + THEN IF NOT is niltask (channel owner) + THEN ask channel owner to release the channel ; + IF channel owner does not release channel + THEN errorstop ("Task """ + name (channel owner) + + """ gibt Kanal " + + text (channel number) + + " nicht frei") + FI + FI ; + continue (channel number) + FI . + +i am not channel owner : + channel <> channel number . + +ask channel owner to release the channel : + forget (ds) ; + ds := nilspace ; + pingpong (channel owner, free code, ds, reply) . + +channel owner does not release channel : + (reply <> ack) AND task exists . + +task exists : + reply <> -1 . + +ENDPROC continue channel ; + + +END PACKET global manager ; + |