path: root/system/base/1.7.5/src/local manager

(* ------------------- VERSION 2     24.02.86 ------------------- *)
PACKET local manager                         (* Autor: J.Liedtke  *) 
 
  DEFINES 
          create,        (* neue lokale Datei einrichten *) 
          new,           (* 'create' und Datei liefern   *) 
          old,           (* bestehende Datei liefern     *) 
          forget,        (* lokale Datei loeschen        *) 
          exists,        (* existiert Datei (lokal) ?    *) 
          status,        (* setzt und liefert Status     *)
          rename,        (* Umbenennung                  *) 
          copy ,         (* Datenraum in Datei kopieren  *) 
          enter password,(* Passwort einfuehren          *)
          write password ,
          read password ,
          write permission ,
          read permission ,
          begin list ,
          get list entry ,
          all :

 
 
LET size = 200 ,
    nil  = 0 ;

INT VAR index ; 
 
TEXT VAR system write password := "" ,
         system read password := "" ,
         actual password ;

INITFLAG VAR this packet := FALSE ;

DATASPACE VAR password space ;

BOUND ROW size STRUCT (TEXT write, read) VAR passwords ;
 
 
THESAURUS VAR dir := empty thesaurus ;

ROW size STRUCT (DATASPACE ds,
                 BOOL protected,
                 TEXT status) VAR crowd ;
 

PROC initialize if necessary :

  IF NOT initialized (this packet)
    THEN system write password := "" ;
         system read password := "" ;
         dir := empty thesaurus ;
         password space := nilspace ;
         passwords := password space 
  FI

ENDPROC initialize if necessary ;

 
 
PROC create (TEXT CONST name) : 
 
IF exists (name )
  THEN error (name, "existiert bereits") ; 
       index := nil 
  ELSE insert and initialize entry 
FI . 
 
insert and initialize entry : 
  disable stop ;
  insert (dir, name, index) ; 
  IF index <> nil 
    THEN crowd (index).ds := nilspace ;
         IF is error
           THEN delete (dir, name, index) ;
                LEAVE create 
         FI ;
         status (name, "") ;
         crowd (index).protected := FALSE
  ELIF NOT is error
    THEN errorstop ("zu viele Dateien")
  FI . 
 
ENDPROC create ; 
 
DATASPACE PROC new (TEXT CONST name) : 
 
  create (name) ; 
  IF index <> nil 
    THEN crowd (index).ds 
    ELSE nilspace 
  FI 
 
ENDPROC new ; 
 
DATASPACE PROC old (TEXT CONST name) : 
 
  initialize if necessary ;
  index := link (dir, name) ;
  IF index = 0
    THEN error (name, "gibt es nicht") ;
         nilspace
    ELSE space
  FI .

space : crowd (index).ds .
 
ENDPROC old ; 
 
DATASPACE PROC old (TEXT CONST name, INT CONST expected type) :

  initialize if necessary ;
  index := link (dir, name) ;
  IF index = 0
    THEN error (name, "gibt es nicht") ;
         nilspace
  ELIF type (space) <> expected type
    THEN errorstop ("Datenraum hat falschen Typ") ;
         nilspace
    ELSE space
  FI .

space : crowd (index).ds .

ENDPROC old ;

BOOL PROC exists (TEXT CONST name) : 
 
  initialize if necessary ;
  dir CONTAINS name 
 
ENDPROC exists ; 
 
PROC forget (TEXT CONST name ) : 
 
  initialize if necessary ;
  say ("""") ;
  say (name) ;
  IF   NOT exists (name)   THEN say (""" existiert nicht") 
  ELIF yes (""" loeschen") THEN forget (name, quiet)
  FI .
 
ENDPROC forget ;

PROC forget (TEXT CONST name, QUIET CONST q) :
  
  initialize if necessary ;
  disable stop ;
  delete (dir, name, index) ; 
  IF index <> nil 
    THEN forget ( crowd (index).ds ) ;
         crowd (index).status := ""
  FI .
 
ENDPROC forget ; 
 
PROC forget :
 
  BOOL VAR status := command dialogue ;
  command dialogue (TRUE) ;
  forget (last param) ;
  command dialogue (status)
 
ENDPROC forget ;
 
PROC status (TEXT CONST name, status text) :
 
  initialize if necessary ;
  INT VAR index := link (dir, name) ; 
  IF index > 0 
    THEN crowd (index).status := date + " " + text (status text, 4)
  FI 
 
ENDPROC status ; 
 
TEXT PROC status (TEXT CONST name) :
 
  initialize if necessary ;
  INT VAR index := link (dir, name) ;
  IF index > 0
    THEN crowd (index).status
    ELSE ""
  FI
 
ENDPROC status ;
 
PROC status (INT CONST pos, TEXT CONST status pattern) :
 
  initialize if necessary ;
  INT VAR index := 0 ;
  WHILE index < highest entry (dir) REP
    index INCR 1 ;
    replace (actual status, pos , status pattern)
  PER .
 
actual status : crowd (index).status .
 
ENDPROC status ;
 
PROC copy (DATASPACE CONST source, TEXT CONST dest name) : 
 
  IF exists (dest name)
    THEN error (dest name, "existiert bereits") 
    ELSE copy file
  FI .
 
copy file :
  disable stop ;
  create ( dest name ) ;
  INT VAR index := link (dir, dest name) ;
  IF index > nil
    THEN forget (crowd (index).ds) ;
         crowd (index).ds := source 
  FI 
 
ENDPROC copy ; 
 
PROC copy (TEXT CONST source name, dest name) :
 
  copy (old (source name), dest name)
 
ENDPROC copy ;
 
PROC rename (TEXT CONST old name, new name) : 
 
  IF exists (new name)
    THEN error (new name, "existiert bereits")
  ELIF exists (old name)
    THEN rename (dir, old name, new name) ;
         last param (new name)
  ELSE   error (old name, "gibt es nicht")
  FI .
 
ENDPROC rename ;
 
 
PROC begin list :
 
  initialize if necessary ;
  index := 0
 
ENDPROC begin list ;
 
PROC get list entry (TEXT VAR entry, status text) :
 
  get (dir, entry, index) ;
  IF found 
    THEN status text := crowd (index).status ;
    ELSE status text := "" ;
  FI .
 
found : index > 0 .
 
ENDPROC get list entry ;
 
 
TEXT PROC write password :
 
  system write password
 
ENDPROC write password ;
 
TEXT PROC read password :
 
  system read password
 
ENDPROC read password ;
 

PROC enter password (TEXT CONST password) :
 
  initialize if necessary ;
  say (""3""5"") ;
  INT CONST slash pos := pos (password, "/") ;
  IF slash pos = 0
    THEN system write password := password ;
         system read password  := password
    ELSE system write password := subtext (password, 1, slash pos-1) ;
         system read password  := subtext (password, slash pos+1)
  FI .
 
ENDPROC enter password ;
 
PROC enter password (TEXT CONST file name, write pass, read pass) :
 
  INT CONST index := link (dir, file name) ;
  IF index > 0
    THEN set protect password
  FI .

set protect password :
  IF write pass = "" AND read pass = ""
    THEN crowd (index).protected := FALSE
    ELSE crowd (index).protected := TRUE ;
         passwords (index).write := write pass ;
         passwords (index).read  := read pass
  FI .
 
ENDPROC enter password ;
 
INT PROC password index (TEXT CONST file name) :

  initialize if necessary ;
  INT CONST index := link (dir, file name) ;
  IF index > 0 CAND crowd (index).protected
    THEN index
    ELSE 0
  FI

ENDPROC password index ;

BOOL PROC read permission (TEXT CONST name, supply password) :
 
  (****************************************************************) 
  (*  for reasons of data security the password check algorithm   *)
  (*  must not copy parts of the file password into variables     *)
  (*  located in the standard dataspace!                          *)
  (****************************************************************)

  access file password ;
  file has no password COR (supply password <> "-" AND read password match) .

read password match :
  file password.read = supply password OR file password.read = "" .

access file password :
  INT CONST pw index := password index (name) .

file password :  passwords (pw index) .

file has no password :  pw index = 0 .

ENDPROC read permission ;
 
BOOL PROC write permission (TEXT CONST name, supply password) :
 
  (****************************************************************) 
  (*  for reasons of data security the password check algorithm   *)
  (*  must not copy parts of the file password into variables     *)
  (*  located in the standard dataspace!                          *)
  (****************************************************************)

  access file password ;
  file has no password COR (supply password <> "-" AND write password match).

write password match :
  file password.write = supply password OR file password.write = "" .

access file password :
  INT CONST pw index := password index (name) .

file password :  passwords (pw index) .

file has no password :  pw index = 0 .

ENDPROC write permission ;
 
THESAURUS PROC all :

  initialize if necessary ;
  THESAURUS VAR result := dir ; (*ueberfluessig ab naechstem Compiler *)
  result

ENDPROC all ;

PROC error (TEXT CONST file name, error text) :

  errorstop ("""" + file name + """ " + error text)

ENDPROC error ;

ENDPACKET local manager ;