-- UserCredentialsUnsafeImpl.mesa
-- last edited by Levin on March 11, 1983 11:31 am

DIRECTORY
  Ascii: TYPE USING [
    BS, ControlA, ControlQ, ControlR, ControlV, ControlW, ControlX, CR, DEL, ESC, SP],
  BodyDefs: TYPE USING [maxRNameLength],
  BootSwap: TYPE USING [mdsiGerm],
  DESFace: TYPE USING [Block, DecryptBlock, EncryptBlock, MakeKey],
  DiskChannel: TYPE USING [
    CompletionHandle, Create, CreateCompletionObject, Delete, DiskPageCount,
    DiskPageNumber, Drive, GetDriveAttributes, GetNextDrive, Handle, InitiateIO, IORequest,
    Label, nullDrive, nullHandle, WaitAny],
  Environment: TYPE USING [LongNumber, wordsPerPage],
  File: TYPE USING [ID],
  Heap: TYPE USING [systemMDSZone, systemZone],
  Inline: TYPE USING [BITXOR],
  LongString: TYPE USING [AppendChar, AppendString, EquivalentStrings, StringBoundsFault],
  NameInfoDefs: TYPE USING [Authenticate, Outcome],
  PilotDisk: TYPE USING [],
  PilotMP: TYPE USING [cClient],
  PrincOpsRuntime: TYPE USING [GFT],
  Process: TYPE USING [InitializeMonitor, Pause, SecondsToTicks],
  ProcessorFace: TYPE USING [SetMP],
  SDDefs: TYPE USING [SD, sGFTLength],
  Space: TYPE USING [
    Create, Delete, GetHandle, Handle, LongPointer, Map, PageFromLongPointer, virtualMemory],
  SpecialSpace: TYPE USING [MakeResident, MakeSwappable],
  System: TYPE USING [UniversalID],
  UserCredentialsUnsafe: TYPE USING [defaultOptions, GetProc, LoginOptions, PutProc, State];
  
UserCredentialsUnsafeImpl: MONITOR
  IMPORTS 
    DESFace, DiskChannel, Heap, Inline, NameInfoDefs, Process, ProcessorFace,
    Space, SpecialSpace, String: LongString
  EXPORTS UserCredentialsUnsafe
  SHARES PilotDisk -- to get at structure of a disk label -- =

BEGIN


IllegalParameter: ERROR = CODE;

PanelCode: TYPE = CARDINAL;
bug: PanelCode = 998;  -- = CedarInitPrivate.ErrorCode[implementationBug]
hardDiskError: PanelCode = 992;
diskOffline: PanelCode = 993;


-- Declarations for data structures on disk

State: TYPE = UserCredentialsUnsafe.State;

credentialsImplID: CARDINAL = 08312;
obsoleteImplID: CARDINAL = credentialsImplID - 1;  -- anything other than credentialsImplID

decryptedID: DESFace.Block = ALL[credentialsImplID];

Credentials: TYPE = LONG POINTER TO CredentialsObject;
CredentialsObject: TYPE = MACHINE DEPENDENT RECORD [
  implementationID(0): CARDINAL _ credentialsImplID,
  checksum(1): CARDINAL _ 0,
  fill(2:0..13): CARDINAL[0..17777B] _ 0,
  kind(2:14..14+2+6*16-1): SELECT state(2:14..15): State FROM
    noCredentials => NULL,
    name => [
        encryptedID(3): DESFace.Block _ NULL,
        userName(7): StringBody _ [length: 0, maxlength: NULL, text: NULL]
        -- The text portion of the userName follows here
        ],
    nameHint, nameAndPassword => [
        userName(3): StringBody _ [length: 0, maxlength: NULL, text: NULL]
        -- The text portion of the userName follows here
        -- If state = nameAndPassword, another StringBody follows
        ],
    ENDCASE
  ];

bogusCredentials: CredentialsObject = [implementationID: obsoleteImplID, kind: noCredentials[]];

diskCredentialsPage: DiskChannel.DiskPageNumber = 2;  -- should come from DiskFace or somewhere
diskCredentialsPages: DiskChannel.DiskPageCount = 
  (SIZE[nameAndPassword CredentialsObject] - SIZE[StringBody[0]] +
   2*SIZE[StringBody[BodyDefs.maxRNameLength]]
   + Environment.wordsPerPage - 1)/Environment.wordsPerPage;

UniversalID: TYPE = ARRAY [0..SIZE[System.UniversalID]) OF WORD;

credentialsFileID: File.ID =
  LOOPHOLE[UniversalID[076543B, 021076B, 054321B, 076543B, 021076B]];
credentialsLabel: DiskChannel.Label = [
  fileID: credentialsFileID, filePageLo: 0, filePageHi: 0,
  immutable: FALSE, temporary: FALSE, zeroSize: FALSE,
  type: [0], bootChainLink: [0, 0]];

DiskNotReady: ERROR = CODE;
BrokenDisk: ERROR = CODE;


-- Declarations for data structures in memory (germ)


GermString: TYPE = LONG POINTER TO LONG STRING;

germMDSln: Environment.LongNumber = [num[highbits: BootSwap.mdsiGerm, lowbits: 0]];
germMDS: LONG POINTER = germMDSln.lp;  -- compiler coughs if combined with above.
germGFT: LONG POINTER = LOOPHOLE[germMDS+LOOPHOLE[PrincOpsRuntime.GFT, CARDINAL]];
germSD: LONG POINTER TO ARRAY [0..0) OF UNSPECIFIED =
  LOOPHOLE[germMDS+LOOPHOLE[SDDefs.SD, CARDINAL]];
nameInGerm: GermString = LOOPHOLE[germGFT+LOOPHOLE[germSD[SDDefs.sGFTLength], CARDINAL]];
passwordInGerm: GermString = nameInGerm + SIZE[LONG STRING];
germFreeSpace: LONG POINTER = passwordInGerm + SIZE[LONG STRING];
germFreeSpaceCount: CARDINAL =
  (germSD[SDDefs.sGFTLength] + Environment.wordsPerPage - 1)/Environment.wordsPerPage -
  (germSD[SDDefs.sGFTLength] + 2*SIZE[LONG STRING]);



-- Exports to UserCredentialsUnsafe

Login: PUBLIC ENTRY PROC [
  startInteraction: PROC RETURNS [UserCredentialsUnsafe.GetProc, UserCredentialsUnsafe.PutProc],
  endInteraction: PROC,
  options: UserCredentialsUnsafe.LoginOptions _ UserCredentialsUnsafe.defaultOptions] = {
  ENABLE UNWIND => NULL;
  credentials: Credentials _ NIL;
  dirty: BOOL _ FALSE;
  terminalOn: BOOL _ FALSE;
  EnsureTerminalOn: PROC =
    {IF ~terminalOn THEN {[getChar, putChar] _ startInteraction[]; terminalOn _ TRUE}};
  EnsureTerminalOff: PROC =
    {IF terminalOn THEN endInteraction[]};
  HandleDiskNotReady: PROC = {
    ProcessorFace.SetMP[diskOffline];
    EnsureTerminalOn[];
    PutString["Disk is not ready...will retry..."L];
    Process.Pause[Process.SecondsToTicks[5]];
    PutString["retrying\N"L];
    ProcessorFace.SetMP[PilotMP.cClient];
    };
  CleanupOnAbort: INTERNAL PROC = {
    IF ~options.ignoreDiskEntirely THEN ReleaseDiskCredentials[credentials, FALSE];
    FreeCredentials[credentials];
    SetUserCredentialsInternal[NIL, NIL];
    };
  EnsureInitialized[];
  IF ~options.alwaysPrompt AND nameInGerm^.length > 0 THEN RETURN;  -- already logged in
  credentials _ AllocateCredentials[];
  IF options.ignoreDiskEntirely THEN credentials^ _ bogusCredentials
  ELSE AcquireDiskCredentials[credentials ! DiskNotReady => {HandleDiskNotReady[]; RETRY}];
  IF credentials.implementationID = credentialsImplID THEN {
    CheckCredentials: INTERNAL PROC [credentials: Credentials]
      RETURNS [ok: BOOL _ TRUE] = --INLINE-- {
      Downgrade: INTERNAL PROC [credentials: Credentials, state: State] = --INLINE--
        {[] _ ChangeCredentialsStateInternal[credentials, state]; dirty _ TRUE; ok _ FALSE};
      WITH cred: credentials SELECT FROM
        nameHint => {
          diskUserName: LONG STRING = @cred.userName;
          EnsureTerminalOn[];
          SetUserCredentialsInternal[diskUserName, NIL];
          [] _ GetAndAuthenticate[ ! UNWIND => CleanupOnAbort[]];
          IF (dirty _ ~String.EquivalentStrings[diskUserName, nameInGerm^]) THEN
            [] _ ChangeCredentialsStateInternal[credentials, nameHint];
          };
        nameAndPassword => {
          diskUserName: LONG STRING = @cred.userName;
          diskPassword: LONG STRING = diskUserName + SIZE[StringBody[diskUserName.length]];
          SetUserCredentialsInternal[diskUserName, diskPassword];
          SELECT AuthenticateInternal[diskUserName, diskPassword] FROM
            individual, allDown => NULL;
            notFound, group => Downgrade[credentials, nameHint];
            badPwd => Downgrade[credentials, name]; 
            ENDCASE => HardStop[bug];
          };
        name => {
          EnsureTerminalOn[];
          SetUserCredentialsInternal[@cred.userName, NIL];
          DO  -- loops only if GV down and password supplied doesn't work.
            block: DESFace.Block;
            SELECT GetAndAuthenticate[passwordOnly ! UNWIND => CleanupOnAbort[]] FROM
              ok => {
                -- Grapevine is up, and the credentials are valid.  The password used to encrypt
                -- the information in the credentials file may not be the same one that was used
                -- (successfully) to authenticate the user to Grapevine.  After all, the user may
                -- have changed his password in the Grapevine database since this procedure
                -- was last called.  However, since the user name presented to Grapevine
                -- was forced to come from the disk and Grapevine authenticated the user, we
                -- can be confident that this is the same user who requested that the encrypted
                -- information be stored on the disk originally.  We therefore encrypt with
                -- the new password and rewrite the credentials file.  In effect, this gives
                -- us a cache of the last successful Grapevine authentication, which will be
                -- useful if Grapevine proves to be down on a subsequent Login.
                DESFace.DecryptBlock[
                  key: DESFace.MakeKey[passwordInGerm^],
                  from: @cred.encryptedID, to: @block];
                IF (dirty _ dirty OR (block ~= decryptedID)) THEN
                  [] _ ChangeCredentialsStateInternal[credentials, name];
                };
              bogusGVName => Downgrade[credentials, nameHint];
              gvDown => {
                -- Grapevine is down, so we must fall back on our cached information on
                -- the disk.  We use the password supplied by the user to decrypt then compare 
                -- it with the expected value.  If it matches, the user is assumed to be
                -- authentic, and the password he supplied is highly likely to be the one
                -- he last successfully used to authenticate himself with Grapevine.
                DESFace.DecryptBlock[
                  key: DESFace.MakeKey[passwordInGerm^],
                  from: @cred.encryptedID, to: @block];
                IF block ~= decryptedID THEN {PutString["Wrong credentials!\N"L]; LOOP};
                };
              ENDCASE;
            EXIT
            ENDLOOP;
          };
        ENDCASE => HardStop[bug];
      };
    UNTIL CheckCredentials[credentials] DO ENDLOOP;
    }
  ELSE {
    ENABLE UNWIND => CleanupOnAbort[];
    RewriteDisk: PROCEDURE RETURNS [rewrite: BOOLEAN] = INLINE {
      IF options.ignoreDiskEntirely THEN RETURN[FALSE];
      IF ~options.confirmCredentialsOverwrite THEN RETURN[TRUE];
      RETURN[~Confirm["Disk credentials missing or obsolete; shall I leave it that way? "L]]
      };
    EnsureTerminalOn[];
    IF (dirty _ RewriteDisk[]) THEN
      [] _ ChangeCredentialsStateInternal[credentials,
        IF ~options.prohibitDiskProtection AND GetAndAuthenticate[] = ok AND
          Confirm["Do you wish to prevent others from accessing your disk? "L] THEN name
        ELSE nameHint]
    ELSE [] _ GetAndAuthenticate[];
    };
  IF ~options.ignoreDiskEntirely THEN 
    ReleaseDiskCredentials[credentials, dirty
      ! BrokenDisk => {
        EnsureTerminalOn[];
        PutString["Disk error rewriting credentials file...I give up\N"L];
        HardStop[hardDiskError];
        };
        DiskNotReady => {HandleDiskNotReady[]; RETRY};
      ];
  FreeCredentials[credentials];
  EnsureTerminalOff[];
  };

GetCredentialsState: PUBLIC ENTRY PROC RETURNS [state: State] = {
  credentials: Credentials = AllocateCredentials[];
  AcquireDiskCredentials[credentials];
  state _ GetCredentialsStateInternal[credentials];
  ReleaseDiskCredentials[credentials, FALSE];
  FreeCredentials[credentials];
  };

ChangeCredentialsState: PUBLIC ENTRY PROC [new: State] RETURNS [old: State] = {
  -- The internal signals from AcquireDiskCredentials and ReleaseDiskCredentials are
  -- presently uncaught, since we don't have any better way of dealing with them.
  credentials: Credentials = AllocateCredentials[];
  AcquireDiskCredentials[credentials];
  old _ ChangeCredentialsStateInternal[credentials, new];
  ReleaseDiskCredentials[credentials, TRUE];
  FreeCredentials[credentials];
  };

GetUserCredentials: PUBLIC ENTRY PROC [name, password: LONG STRING] = {
  EnsureInitialized[];
  GetUserCredentialsInternal[name, password];
  };

SetUserCredentials: PUBLIC ENTRY PROC [name, password: LONG STRING] =
  -- The implementation of SetUserCredentialsInternal is such that we need not call
  -- EnsureInitialized (indeed, note how EnsureInitialized is implemented).
  {SetUserCredentialsInternal[name, password]};

Authenticate: PUBLIC ENTRY PROC RETURNS [outcome: NameInfoDefs.Outcome] = {
  EnsureInitialized[];
  RETURN[AuthenticateInternal[nameInGerm^, passwordInGerm^]]
  };

-- *** For emergency use only ***

BreakIn: PROC = {
  BreakInInternal: ENTRY PROC = INLINE {
    credentials: CredentialsObject;
    [] _ ChangeCredentialsStateInternal[@credentials, noCredentials];
    ReleaseDiskCredentials[@credentials, TRUE];
    };
  Process.InitializeMonitor[@LOCK];
  BreakInInternal[];
  };

-- Internal procedures

EnsureInitialized: INTERNAL PROC =
  -- Note: one might think that this could be done at module start time, rather than
  -- on every call to a public procedure of this module.  However, the contents of the
  -- germ mds can change after this module is started (e.g., a checkpoint is taken, then
  -- a physical boot causes a rollback).
  {IF nameInGerm^ = NIL THEN SetUserCredentialsInternal[NIL, NIL]};

GetUserCredentialsInternal: INTERNAL PROC [name, password: LONG STRING] = {
  IF name ~= NIL THEN {name.length _ 0; String.AppendString[name, nameInGerm^]};
  IF password ~= NIL THEN {password.length _ 0; String.AppendString[password, passwordInGerm^]};
  };

SetUserCredentialsInternal: INTERNAL PROC [name, password: LONG STRING] = {
  empty: LONG STRING _ [0];
  IF name = NIL THEN name _ empty;
  IF password = NIL THEN password _ empty;
  IF SIZE[StringBody[name.length]] + SIZE[StringBody[password.length]] > germFreeSpaceCount OR
    name.length > BodyDefs.maxRNameLength OR password.length > BodyDefs.maxRNameLength THEN
    ERROR IllegalParameter;
  nameInGerm^ _ germFreeSpace;
  nameInGerm^^ _ StringBody[maxlength: name.length, text: ];
  String.AppendString[nameInGerm^, name];
  passwordInGerm^ _ nameInGerm^ + SIZE[StringBody[name.length]];
  passwordInGerm^^ _ StringBody[maxlength: password.length, text: ];
  String.AppendString[passwordInGerm^, password];
  };

GetCredentialsStateInternal: INTERNAL PROC [credentials: Credentials]
  RETURNS [State] = INLINE {RETURN[credentials.state]};

ChangeCredentialsStateInternal: INTERNAL PROC [credentials: Credentials, new: State]
  RETURNS [old: State] = {
  words: CARDINAL;
  old _ credentials.state;
  SELECT new FROM
    noCredentials => {
      credentials^ _ bogusCredentials;
      words _ SIZE[noCredentials CredentialsObject];
      };
    name => {
      credentials^ _
        [kind: name[encryptedID: , userName: StringBody[maxlength: nameInGerm^.length, text: ]]];
      WITH cred: credentials SELECT FROM
        name => {
          block: DESFace.Block _ decryptedID;
          DESFace.EncryptBlock[
            key: DESFace.MakeKey[passwordInGerm^],
            from: @block, to: @cred.encryptedID];
          String.AppendString[@cred.userName, nameInGerm^];
          };
        ENDCASE => HardStop[bug];
      words _ SIZE[name CredentialsObject] +
        (SIZE[StringBody[nameInGerm^.length]] - SIZE[StringBody[0]]);
      };
    nameHint => {
      credentials^ _
        [kind: nameHint[userName: StringBody[maxlength: nameInGerm^.length, text: ]]];
      WITH cred: credentials SELECT FROM
        nameHint => String.AppendString[@cred.userName, nameInGerm^];
        ENDCASE => HardStop[bug];
      words _ SIZE[nameHint CredentialsObject] +
        (SIZE[StringBody[nameInGerm^.length]] - SIZE[StringBody[0]]);
      };
    nameAndPassword => {
      credentials^ _
        [kind: nameAndPassword[userName: StringBody[maxlength: nameInGerm^.length, text: ]]];
      WITH cred: credentials SELECT FROM
        nameAndPassword => {
          diskUserName: LONG STRING = @cred.userName;
          diskPassword: LONG STRING = @cred.userName + SIZE[StringBody[nameInGerm^.length]];
          String.AppendString[@cred.userName, nameInGerm^];
          diskPassword^ _ StringBody[maxlength: passwordInGerm^.length, text: ];
          String.AppendString[diskPassword, passwordInGerm^];
          };
        ENDCASE => HardStop[bug];
      words _ SIZE[nameAndPassword CredentialsObject] +
        (SIZE[StringBody[nameInGerm^.length]] - SIZE[StringBody[0]]) +
        SIZE[StringBody[passwordInGerm^.length]];
      };
    ENDCASE => HardStop[bug];
  credentials.checksum _ ComputeChecksum[DESCRIPTOR[credentials, words]];
  };

ComputeChecksum: INTERNAL PROCEDURE [input: LONG DESCRIPTOR FOR ARRAY OF WORD]
  RETURNS [checksum: WORD _ 0] = {
  FOR i: CARDINAL IN [0..LENGTH[input]) DO
    checksum _ Inline.BITXOR[checksum, input[i]];
    ENDLOOP;
  };

ValidChecksum: INTERNAL PROCEDURE [input: LONG DESCRIPTOR FOR ARRAY OF WORD]
  RETURNS [ok: BOOLEAN] = {
  checksum: WORD _  0;
  FOR i: CARDINAL IN [0..LENGTH[input]) DO
    checksum _ Inline.BITXOR[checksum, input[i]];
    ENDLOOP;
  RETURN[checksum = 0]
  };

AuthenticateInternal: INTERNAL PROC [name, password: LONG STRING]
  RETURNS [outcome: NameInfoDefs.Outcome] = {
  nameMDS: STRING _ Heap.systemMDSZone.NEW[StringBody[name.length]];
  passwordMDS: STRING _ Heap.systemMDSZone.NEW[StringBody[password.length]];
  String.AppendString[nameMDS, name];
  String.AppendString[passwordMDS, password];
  outcome _ NameInfoDefs.Authenticate[nameMDS, passwordMDS];
  Heap.systemMDSZone.FREE[@nameMDS];
  Heap.systemMDSZone.FREE[@passwordMDS];
  };

GetAndAuthenticate: INTERNAL PROCEDURE [askFor: {both, passwordOnly} _ both]
  RETURNS [outcome: {ok, bogusGVName, gvDown} _ ok] = {
  name: LONG STRING _ Heap.systemZone.NEW[StringBody[BodyDefs.maxRNameLength]];
  password: LONG STRING _ Heap.systemZone.NEW[StringBody[BodyDefs.maxRNameLength]];
  defaultRegistry: LONG STRING = ".pa"L;
  cancelString: LONG STRING = " XXX\N"L;
  invalidMsg: LONG STRING = " too long!\N"L;
  PutString["Login please...\N"L];
  DO
    ENABLE UNWIND => PutString[cancelString];
    PutString["Name: "L];
    GetUserCredentialsInternal[name: name, password: NIL];
    IF askFor = passwordOnly THEN PutString[name]
    ELSE {
      [] _ GetID[name
        ! Rubout => {PutString[cancelString]; LOOP};
          String.StringBoundsFault => {PutString[invalidMsg]; LOOP};
        ];
      FOR i: CARDINAL DECREASING IN [0..name.length) DO
        IF name[i] = '. THEN EXIT;
        REPEAT
          FINISHED => {
            PutString[defaultRegistry];
            String.AppendString[name, defaultRegistry
              ! String.StringBoundsFault => {PutString[invalidMsg]; LOOP}];
            };
        ENDLOOP;
      };
    PutString["  password: "L];
    password.length _ 0;
    [] _ GetID[password, FALSE
      ! Rubout => {PutString[cancelString]; LOOP};
        String.StringBoundsFault => {PutString[invalidMsg]; LOOP};
      ];
    SetUserCredentialsInternal[name, password];
    PutString[" GV..."L];
    SELECT AuthenticateInternal[name, password] FROM
      individual => {PutString["ok\N"L]; EXIT};
      notFound, group => {
        PutString["invalid user name"L];
        IF askFor = passwordOnly THEN {PutString["\N"L]; outcome _ bogusGVName; EXIT};
        };
      badPwd => PutString["incorrect password"L];
      allDown => {PutString["Grapevine down, proceeding anyway\N"L]; outcome _ gvDown; EXIT};
      ENDCASE;
    PutString[", try again.\N"L];
    ENDLOOP;
  Heap.systemZone.FREE[@name];
  Heap.systemZone.FREE[@password];
  };

-- TTY-like Interaction Utilities

Rubout: ERROR = CODE;

getChar: UserCredentialsUnsafe.GetProc;  -- used for the duration of Login only
putChar: UserCredentialsUnsafe.PutProc;  -- used for the duration of Login only

PutString: PROC [s: LONG STRING] =
  {FOR i: CARDINAL IN [0..s.length) DO putChar[s[i]]; ENDLOOP};

GetID: PROC [s: LONG STRING, echo: BOOL _ TRUE] RETURNS [c: CHARACTER] =
  BEGIN OPEN Ascii;
  firstTime: BOOLEAN _ TRUE;
  Done: PROCEDURE [c: CHARACTER] RETURNS [yes: BOOLEAN] = INLINE {
    IF firstTime AND echo THEN {
      SELECT c FROM
        ControlA, BS, ControlQ, ControlW, ControlX, CR, SP => NULL;
        ENDCASE => {
          THROUGH [0..s.length) DO putChar[BS] ENDLOOP;
          s.length _ 0};
      firstTime _ FALSE};
    RETURN[c = SP OR c = CR]
    };
  IF echo THEN PutString[s];
  c _ getChar[];
  UNTIL Done[c] DO
    SELECT c FROM
      DEL => ERROR Rubout;
      ControlA, BS => -- backspace
        IF s.length > 0 THEN {IF echo THEN putChar[BS]; s.length _ s.length - 1};
      ControlW, ControlQ => {-- backword
        -- text to be backed up is of the form ...<li><v><ti>, the <v> and <ti> are to
        -- be removed.
        state: {ti, v, li} _ ti;
        FOR i: CARDINAL DECREASING IN [0..s.length) DO
          SELECT s[i] FROM
            IN ['A..'Z], IN ['a..'z], IN ['0..'9] => IF state = ti THEN state _ v;
            ENDCASE => IF state = v THEN state _ li;
          IF state = li THEN GO TO done;
          IF echo THEN putChar[BS];
          REPEAT
            done => s.length _ i + 1;
            FINISHED => s.length _ 0;
          ENDLOOP;
        };
      ControlX => {-- back everything
        IF echo THEN FOR i: CARDINAL IN [0..s.length) DO putChar[BS] ENDLOOP;
        s.length _ 0;
        };
      ControlR => -- refresh -- IF echo THEN {putChar[CR]; PutString[s]};
      ControlV => -- quote next char
        {String.AppendChar[s, c _ getChar[]]; IF echo THEN putChar[c]};
      ENDCASE => {String.AppendChar[s, c]; IF echo THEN putChar[c]};
    c _ getChar[];
    ENDLOOP;
  END;


Confirm: PROCEDURE [message: LONG STRING _ NIL] RETURNS [BOOLEAN] = {
  DO
    IF message ~= NIL THEN PutString[message];
    SELECT getChar[ ! UNWIND => PutString[" XXX\N"L]] FROM
      'y, 'Y, Ascii.SP, Ascii.CR, Ascii.ESC => {PutString["Yes\N"L]; RETURN[TRUE]};
      'n, 'N, Ascii.DEL => {PutString["No\N"L]; RETURN[FALSE]};
      ENDCASE;
    ENDLOOP};

channel: DiskChannel.Handle _ DiskChannel.nullHandle;
completion: DiskChannel.CompletionHandle;
rewriteLabel: BOOL;

AllocateCredentials: INTERNAL PROC RETURNS [credentials: Credentials] = {
  space: Space.Handle = Space.Create[size: diskCredentialsPages, parent: Space.virtualMemory];
  credentials _ Space.LongPointer[space];
  -- Unfortunately, the following consumes unnecessary backing storage, but it isn't much.
  Space.Map[space];
  SpecialSpace.MakeResident[space];
  };

FreeCredentials: INTERNAL PROC [credentials: Credentials] = {
  space: Space.Handle = Space.GetHandle[Space.PageFromLongPointer[credentials]];
  SpecialSpace.MakeSwappable[space];
  Space.Delete[space];
  };

AcquireDiskCredentials: INTERNAL PROC [credentials: Credentials] = {
  request: DiskChannel.IORequest;
  label: DiskChannel.Label _ credentialsLabel;
  IF channel ~= DiskChannel.nullHandle THEN HardStop[bug];
  channel _ DiskChannel.Create[GetDrive[], completion _ DiskChannel.CreateCompletionObject[]];
  -- I'd like to use a constructor, but the declaration isn't conducive (PRIVATE fields)
  request.command _ vvr;
  request.channel _ channel;
  request.diskPage _ diskCredentialsPage;
  request.memoryPage _ Space.PageFromLongPointer[credentials];
  request.count _ diskCredentialsPages;
  request.label _ @label;
  request.dontIncrement _ FALSE;
  DiskChannel.InitiateIO[@request];
  IF DiskChannel.WaitAny[completion] ~= @request THEN HardStop[bug];
  rewriteLabel _ FALSE;
  SELECT request.status FROM
    goodCompletion => {
      words: CARDINAL;
      WITH cred: credentials SELECT FROM
        noCredentials => words _ SIZE[noCredentials CredentialsObject];
        name =>
          words _ SIZE[name CredentialsObject] +
            (SIZE[StringBody[cred.userName.length]] - SIZE[StringBody[0]]);
        nameHint =>
          words _ SIZE[nameHint CredentialsObject] +
            (SIZE[StringBody[cred.userName.length]] - SIZE[StringBody[0]]);
        nameAndPassword => {
          diskUserName: LONG STRING = @cred.userName;
          diskPassword: LONG STRING = @cred.userName + SIZE[StringBody[diskUserName.length]];
          words _ SIZE[nameAndPassword CredentialsObject] +
            (SIZE[StringBody[diskUserName.length]] - SIZE[StringBody[0]]) +
            SIZE[StringBody[diskPassword.length]];
          };
        ENDCASE;
      IF ~ValidChecksum[DESCRIPTOR[credentials, words]] THEN credentials^ _ bogusCredentials;
      };
    labelDoesNotMatch, labelError =>
      {rewriteLabel _ TRUE; credentials^ _ bogusCredentials};
    seekFailed, dataError, hardwareError =>
      -- The disk is there, but it doesn't seem to work, treat as "no credentials" now.
      credentials^ _ bogusCredentials;
    notReady => {CleanupIO[]; ERROR DiskNotReady};
    noSuchPage, notPilotVolume, invalidChannel, checkError => HardStop[bug];
    ENDCASE;
  };

ReleaseDiskCredentials: INTERNAL PROC [credentials: Credentials, dirty: BOOL] = {
  IF dirty THEN {
    request: DiskChannel.IORequest;
    label: DiskChannel.Label _ credentialsLabel;
    IF channel = DiskChannel.nullHandle THEN HardStop[bug];
    -- I'd like to use a constructor, but the declaration isn't conducive (PRIVATE fields)
    request.command _ IF rewriteLabel THEN vww ELSE vvw;
    request.channel _ channel;
    request.diskPage _ diskCredentialsPage;
    request.memoryPage _ Space.PageFromLongPointer[credentials];
    request.count _ diskCredentialsPages;
    request.label _ @label;
    request.dontIncrement _ FALSE;
    DiskChannel.InitiateIO[@request];
    IF DiskChannel.WaitAny[completion] ~= @request THEN HardStop[bug];
    SELECT request.status FROM
      goodCompletion => NULL;
      labelDoesNotMatch => HardStop[bug];
      seekFailed, labelError, dataError, hardwareError => {CleanupIO[]; ERROR BrokenDisk};
      notReady => ERROR DiskNotReady;
      noSuchPage, notPilotVolume, invalidChannel, checkError => HardStop[bug];
      ENDCASE;
    };
  CleanupIO[];
  };

CleanupIO: INTERNAL PROC =
  {DiskChannel.Delete[channel]; channel _ DiskChannel.nullHandle};

GetDrive: PROC RETURNS [drive: DiskChannel.Drive _ DiskChannel.nullDrive] = {
  -- At present, this is rather a crock.  It returns a disk channel for the first drive
  -- holding an online, asserted-Pilot physical volume.
  WHILE (drive _ DiskChannel.GetNextDrive[drive]) ~= DiskChannel.nullDrive DO
    IF DiskChannel.GetDriveAttributes[drive].state = pilot THEN EXIT;
    ENDLOOP;
  };

HardStop: PROC [panelCode: PanelCode] = {
  ProcessorFace.SetMP[panelCode];
  DO ENDLOOP;
  };


-- Start code

Initialize: ENTRY PROC = {EnsureInitialized[]};

Initialize[];

END.