-- Copyright (C) 1981, 1982, 1984  by Xerox Corporation. All rights reserved. 
-- NetDirBuilderInterlocks.mesa, HGM,  6-Nov-84  3:32:39
-- From AccessIO of Oct 9, 1980 7:53 PM (Alto version)
-- From AccessIO of 15-Apr-81 12:00:24 (Pilot 6.0? version)
-- From AccessIO of 12-Jan-82 11:58:35 (Pilot 8.0h version)
-- From AccessIO of 23-Dec-82 11:37:12 (Pilot 10.0d version)
-- From AccessIO of 13-Aug-84 14:25:10 (Pilot 11.1 version)


DIRECTORY
  Ascii USING [CR],
  Cursor USING [Object, Fetch, Set, Store],
  Heap USING [systemZone],
  Inline USING [LongNumber],
  FileName USING [
    AllocVFN, FreeVFN, PackFilename, ResetVFN, UnpackFilename,
    VirtualFilename, VirtualFilenameObject],
  FileTransfer USING [
    Connection, Copy, Create, Error, FileInfo, SetPrimaryCredentials, VetoProc],
  PupLibrarian USING [
    AllFromHereID, OpenLibrarianConnection, CreatePropertyList, CredentialsObject,
    DestroyPropertyList, Error, FileServerObject, FullLibjectID,
    FullLibjectIDHandle, GetPropertyString, GetPropertyTwoWord, Handle,
    Activate, Checkin, Checkout, FindID,
    FindVersion, Query, LibjectID, PropertyList, PropertyPair,
    SnapShotHandle],
  PupLibrarianPN USING [
    ContentsFile, localnamePN, CheckedInReason, CheckedOutBy, CheckedOutReason,
    CheckedOutTOD, CheckedInTOD, UserName],
  MFile USING [Acquire, Error, Handle, Release],
  MStream USING [Create, Error, Handle],
  Process USING [Pause, SecondsToTicks, Ticks],
  Profile USING [GetUser],
  Put USING [Char, Line, Text],
  Stream USING [Handle],
  String USING [AppendString, AppendStringAndGrow, Copy, CopyToNewString, Empty, Equal, Equivalent],
  Time USING [Append, Current, Packed, Unpack],
  UserInput USING [UserAbort],
  PupDefs USING [AppendMyName, PupPackageDestroy, PupPackageMake],
  NetDirBuilderOps USING [log];

NetDirBuilderInterlocks: PROGRAM
  IMPORTS
    Cursor, Heap, PupLibrarian, MFile, MStream, Process, Profile, Put,
    String, FileName, FileTransfer, Time, UserInput, PupDefs, NetDirBuilderOps
  EXPORTS NetDirBuilderOps =
  BEGIN

  OPEN PupLibrarian, PupLibrarianPN;

  z: UNCOUNTED ZONE = Heap.systemZone;

  -- global variable declarations

  VirtualFilename: TYPE = FileName.VirtualFilename;
  VirtualFilenameObject: TYPE = FileName.VirtualFilenameObject;
  ActivateMode: TYPE = {noActivate, activate, activateAndWait};
  ErrorLevel: TYPE = {info, warning, error};

  -- User and User.cm stuff

  currentFid: FullLibjectID;
  person: LONG STRING ← [20];
  pwd: LONG STRING ← [20];
  connect: LONG STRING ← [40];
  connectPwd: LONG STRING ← [20];
  primary: PupLibrarian.CredentialsObject ← [person, pwd];
  secondary: PupLibrarian.CredentialsObject ← [connect, connectPwd];

  reason: LONG STRING ← [40];
  errors, warnings: CARDINAL;

  Switch: TYPE = PACKED ARRAY CHARACTER ['a..'z] OF BOOLEAN;
  switch: Switch ← ALL[FALSE];

  conn: FileTransfer.Connection ← NIL;
  cmdStream: Stream.Handle ← NIL;  --used by GetToken

  libject: LONG STRING = "<Pup>Pup-Network.txt";
  server: PupLibrarian.Handle = PupLibrarian.OpenLibrarianConnection["Marion", pup];

  Lock: PUBLIC PROCEDURE RETURNS [BOOLEAN] =
    BEGIN switch['s] ← TRUE; RETURN[PokePupLibrarian[Retrieve]]; END;

  Abort: PUBLIC PROCEDURE RETURNS [BOOLEAN] =
    BEGIN switch['s] ← FALSE; RETURN[PokePupLibrarian[Store]]; END;

  Unlock: PUBLIC PROCEDURE RETURNS [BOOLEAN] =
    BEGIN switch['s] ← TRUE; RETURN[PokePupLibrarian[Store]]; END;

  PokePupLibrarian: PROCEDURE [proc: PROCEDURE [LONG STRING, BOOLEAN]] RETURNS [BOOLEAN] =
    BEGIN
    SaveUserInfo: PROCEDURE [name, password: LONG STRING] =
      BEGIN
      String.Copy[person, name];
      String.Copy[pwd, password];
      END;
    Profile.GetUser[SaveUserInfo, registry];
    errors ← warnings ← 0;
    PupDefs.PupPackageMake[];
    reason.length ← 0;
    PupDefs.AppendMyName[reason];
    IF conn = NIL THEN
      BEGIN
      conn ← FileTransfer.Create[];
      FileTransfer.SetPrimaryCredentials[
        conn: conn, user: primary.directory, password: primary.password];
      END;
    proc[
      libject, TRUE !
      PupLibrarian.Error => {PostMessage[libject, message, error]; CONTINUE}];
    PupDefs.PupPackageDestroy[];
    RETURN[(errors + warnings) = 0];
    END;

  Aborted: SIGNAL = CODE;

  Retrieve: PROCEDURE [name: LONG STRING, checkOut: BOOLEAN] =
    BEGIN
    fid: FullLibjectIDHandle ← GetCurrentFID[name, activateAndWait];
    plist: PropertyList ← GetLibjectInOutInfo[fid, FALSE];
    outBy: LONG STRING = GetPropertyString[plist, CheckedOutBy].s;
    {
    IF checkOut THEN {
      IF String.Empty[reason] THEN {
        PostMessage[name, "no CheckOut reason supplied"L, error]; GOTO alldone};
      Checkout[
        server, fid, reason !
        PupLibrarian.Error =>
          IF code = checkedOut THEN {
            string: LONG STRING = [80];
            outTime: LONG CARDINAL = GetPropertyTwoWord[
              plist, CheckedOutTOD].ln.lc;
            String.AppendString[string, "Already checked out by "L];
            String.AppendString[string, outBy];
            String.AppendString[string, " at "L];
            Time.Append[string, Time.Unpack[[outTime]]];
            PostMessage[name, string, error];
            GOTO alldone}; UNWIND => GOTO alldone];
      PostMessage[name, "Checked Out"L, info]}
    ELSE {WriteChar[Ascii.CR]};
    IF switch['s] THEN RetrieveFiles[name, plist];
    GOTO alldone;
    EXITS alldone => DestroyPropertyList[plist]};
    END;

  BadNameProperty: PROCEDURE [
    libject, expandedName: LONG STRING, type: {local, remote}] RETURNS [bad: BOOLEAN] =
    BEGIN
    IF (bad ← String.Empty[expandedName]) THEN
      BEGIN
      msg: LONG STRING ← z.NEW[StringBody[100]];  -- do not use frame as it is allocated on ALL calls
      String.AppendString[msg, "has empty "L];
      String.AppendString[msg, IF type = local THEN "local"L ELSE "remote"L];
      String.AppendString[msg, " name property"L];
      PostMessage[libject, msg, warning];
      z.FREE[@msg];
      END;
    END;

  CopyNameProperty: PROCEDURE [plist: PropertyList, type: {local, remote}]
    RETURNS [name: LONG STRING] =
    BEGIN
    name ← String.CopyToNewString[
      GetPropertyString[
      plist, IF type = local THEN localnamePN ELSE ContentsFile].s, z, 20];
    END;

  RetrieveFiles: PROCEDURE [libject: LONG STRING, plist: PropertyList] =
    BEGIN
    remoteName: LONG STRING ← CopyNameProperty[plist, remote];
    localName: LONG STRING ← CopyNameProperty[plist, local];
    rec: VirtualFilenameObject ← [NIL, NIL, NIL, NIL];
    extension: LONG STRING ← [20];
    errors: CARDINAL ← 0;
    IF BadNameProperty[libject, localName, local] THEN RETURN;
    IF BadNameProperty[libject, remoteName, remote] THEN RETURN;
    FileName.UnpackFilename[remoteName, @rec];
    IF switch['s] THEN {
      IF String.Empty[rec.version] THEN {
        PostMessage[remoteName, "Retrieving default version"L, warning]};
      RetrieveOneFile[@rec, libject, localName, NIL]};
    FileName.ResetVFN[@rec, TRUE, TRUE, TRUE, TRUE];
    z.FREE[@localName];
    z.FREE[@remoteName];
    END;

  RetrieveOneFile: PROC [rec: VirtualFilename, libject, localName, ext: LONG STRING] =
    BEGIN
    targetName: LONG STRING ← NIL;
    localVFN: VirtualFilename;
    retrievedVersion: LONG STRING ← [6];
    origVersion: LONG STRING = rec.version;
    checkVersion: BOOLEAN = ~String.Empty[origVersion]
      AND ~String.Equivalent[origVersion, "h"L];
    gotIt: BOOLEAN;

    RetrieveThisOne: PROC [checkVersion: BOOLEAN] RETURNS [BOOLEAN] =
      BEGIN
      localVFN ← FileName.AllocVFN[localName];
      SetTargetName[];
      WriteString["    Retrieving: "L];
      WriteLine[targetName];
      FileTransfer.Copy[
        sourceFile: rec, destFile: localVFN, sourceConn: conn,
        veto: IF checkVersion THEN GetVersion ELSE NIL !
        FileTransfer.Error => {
          SELECT TRUE FROM
            code = skipOperation => REJECT;
            code = cantModify => {
              PostMessage[localName, "can't be modified!"L, error]; GOTO fail};
            ENDCASE => {
              PostMessage[localName, "retrieve failure"L, error]; GOTO fail}}];
      PostMessage["    Retrieved"L, targetName, info];
      RETURN[TRUE];
      EXITS fail => RETURN[FALSE]
      END;

    GetVersion: FileTransfer.VetoProc = {
      remoteInfo: FileTransfer.FileInfo = info[conn].source;
      retrievedVersion.length ← 0;
      String.AppendString[retrievedVersion, remoteInfo.version];
      rec.version ← retrievedVersion;
      SetTargetName[];
      RETURN[do, TRUE]};

    SetTargetName: PROCEDURE = {
      z.FREE[@targetName];
      targetName ← FileName.PackFilename[rec, TRUE, TRUE, TRUE, TRUE]};
    IF ext # NIL THEN {
      String.AppendStringAndGrow[@rec.name, ext, z]; String.AppendString[localName, ext]};
    rec.version ← NIL;
    gotIt ← RetrieveThisOne[TRUE];
    rec.version ← origVersion;
    IF gotIt AND checkVersion
      AND ~String.Equal[origVersion, retrievedVersion] THEN {
      PostMessage[
        libject, "no CheckIn corresponding to most recent store"L, warning];
      [] ← RetrieveThisOne[FALSE]};
    FileName.FreeVFN[localVFN];
    z.FREE[@targetName];
    END;


  Store: PROCEDURE [name: LONG STRING, checkIn: BOOLEAN] =
    BEGIN
    dh: MStream.Handle ← NIL;
    fh: MFile.Handle ← NIL;
    localName: LONG STRING ← NIL;
    remoteName: LONG STRING ← NIL;
    firstStoreError: BOOLEAN ← TRUE;
    fid: FullLibjectIDHandle ← GetCurrentFID[name, activateAndWait];
    plist: PropertyList ← GetLibjectInOutInfo[fid, checkIn];
    reasonPP: LONG POINTER TO String PropertyPair;
    storeSource: BOOLEAN ← switch['s];
    DoNotAttemptStores: PROCEDURE = INLINE {storeSource ← FALSE};
    localName ← CopyNameProperty[plist, local];
    IF storeSource THEN
      BEGIN
      IF BadNameProperty[name, localName, local] THEN {DoNotAttemptStores[]}
      ELSE
        IF storeSource THEN {
          fh ← MFile.Acquire[localName, readOnly, [] ! MFile.Error => CONTINUE];
          IF fh # NIL THEN {
            IF checkIn AND storeSource THEN
              BEGIN
              dh ← MStream.Create[
                fh, [] !
                MStream.Error =>
                  PostMessage[localName, "cannot be opened!"L, error]];
              fh ← NIL;
              END}
          ELSE {
            WriteChar[Ascii.CR];
            PostMessage[localName, "NOT on local disk!"L, error];
            checkIn ← FALSE;
            DoNotAttemptStores[]}};
      END;
    IF checkIn THEN
      BEGIN
      fsh: PupLibrarian.FileServerObject ← [NIL, primary, secondary];
      reasonPP ← GetPropertyString[plist, CheckedInReason].pp;
      z.FREE[@reasonPP.string];
      reasonPP.string ← String.CopyToNewString[reason, z];
      remoteName ← Checkin[
        server, fid, modification, plist, dh, @fsh !
        PupLibrarian.Error =>
          IF code = communicationError OR code = fatalTransferError THEN
            BEGIN
            IF firstStoreError THEN
              PostMessage[localName, "store failure"L, warning];
            firstStoreError ← FALSE;
            IF code = communicationError THEN {WaitForRetry[message, 10]; RESUME };
            END;  --dh destroyed in PupLibrariansB
        UNWIND => DestroyPropertyList[plist]];
      PostMessage[name, "Checked In"L, info];
      IF switch['s] THEN PostMessage["    Stored"L, remoteName, info];
      storeSource ← FALSE;
      END
    ELSE
      IF storeSource THEN {
        outBy: LONG STRING = GetPropertyString[plist, CheckedOutBy].s;
        IF storeSource AND switch['m]
          AND ~String.Equivalent[person, outBy] THEN {
          PostMessage[name, "skipped, since not checked out to you."L, info];
          switch['d] ← FALSE;
          DoNotAttemptStores[]}
        ELSE {remoteName ← CopyNameProperty[plist, remote]; WriteChar[Ascii.CR]}};
    IF storeSource THEN
      BEGIN
      IF BadNameProperty[name, remoteName, remote] THEN storeSource ← FALSE
      ELSE StoreFiles[name, localName, remoteName, ~checkIn AND storeSource];
      END;
    IF fh # NIL THEN BEGIN MFile.Release[fh ! MFile.Error => CONTINUE]; END;
    DestroyPropertyList[plist];
    z.FREE[@remoteName];
    z.FREE[@localName];
    END;

  StoreFiles: PROCEDURE [
    libject, localName, remoteName: LONG STRING, storeOrig: BOOLEAN] =
    BEGIN
    targetFH: MFile.Handle ← NIL;
    remoteVFN: VirtualFilenameObject ← [NIL, NIL, NIL, NIL];
    extension: LONG STRING ← [20];
    FileName.UnpackFilename[remoteName, @remoteVFN];
    FileName.ResetVFN[@remoteVFN, FALSE, FALSE, FALSE, TRUE];
    IF storeOrig THEN
      StoreOneFile[@remoteVFN, libject, localName, NIL, FALSE, FALSE];
    FileName.ResetVFN[@remoteVFN, TRUE, TRUE, TRUE, TRUE];
    END;

  StoreOneFile: PROCEDURE [
    rec: VirtualFilename, libject, localName, ext: LONG STRING, missingOK: BOOLEAN,
    checkFile: BOOLEAN] =
    BEGIN
    targetFH: MFile.Handle ← NIL;
    targetRemoteName: LONG STRING;
    storedIt: BOOLEAN ← TRUE;
    doingRetry: BOOLEAN ← FALSE;
    localVFN: VirtualFilenameObject ← [NIL, NIL, NIL, NIL];
    IF ext # NIL THEN
      BEGIN
      String.AppendStringAndGrow[@rec.name, ext, z];
      String.AppendString[localName, ext];
      END;
    IF checkFile THEN
      BEGIN
      -- librarian maps ftp error to something unrecognizable; check if local file exists 
      targetFH ← MFile.Acquire[localName, readOnly, [] ! MFile.Error => CONTINUE];
      IF targetFH = NIL THEN {
        IF ~missingOK THEN PostMessage[localName, "NOT on local disk!"L, warning];
        RETURN};
      -- don't forget to release handle
      END;
    FileName.UnpackFilename[localName, @localVFN];
    FileTransfer.Copy[
      destFile: rec, sourceFile: @localVFN, destConn: conn !
      FileTransfer.Error => {
        IF code # skipOperation THEN REJECT;
        PostMessage[localName, "store failure"L, error];
        storedIt ← FALSE;
        CONTINUE}];
    IF storedIt THEN {
      targetRemoteName ← FileName.PackFilename[rec, TRUE, TRUE, TRUE, TRUE];
      PostMessage["    Stored"L, targetRemoteName, info]};
    z.FREE[@targetRemoteName];
    FileName.ResetVFN[@localVFN, TRUE, TRUE, TRUE, TRUE];
    END;

  -- Library Support routines

  GetCurrentFID: PROCEDURE [name: LONG STRING, mode: ActivateMode]
    RETURNS [fid: FullLibjectIDHandle] =
    BEGIN
    id: LibjectID;
    active: BOOLEAN;
    snapFid: FullLibjectID;
    snapshot: SnapShotHandle ← DESCRIPTOR[@snapFid, 1];
    [id, active] ← FindID[
      server: server, s: name, activate: mode # noActivate, wait: FALSE];
    IF ~active AND mode = activateAndWait THEN {
      WriteString[" (activating)"L];
      Activate[server: server, id: id, wait: TRUE]};
    snapFid ← FullLibjectID[
      id: AllFromHereID,
      version: [
      type: timeAndDate,
      body: timeAndDate[
      pad: -- Must be default until Service > 5.1! -- , tod: Time.Current[]]]];
    currentFid ← FindVersion[server, id, snapshot]↑;
    fid ← @currentFid;
    END;

  GetLibjectInOutInfo: PROCEDURE [
    fid: FullLibjectIDHandle, checkInReason: BOOLEAN]
    RETURNS [plist: PropertyList] =
    BEGIN
    plist ← CreatePropertyList[IF checkInReason THEN 6 ELSE 5];
    plist[0] ← PropertyPair[FALSE, localnamePN.prefix, String[NIL]];
    plist[1] ← PropertyPair[FALSE, ContentsFile.prefix, String[NIL]];
    plist[2] ← PropertyPair[FALSE, CheckedOutBy.prefix, String[NIL]];
    plist[3] ← PropertyPair[FALSE, CheckedOutTOD.prefix, TwoWord[Inline.LongNumber[lc[0]]]];
    plist[4] ← PropertyPair[FALSE, CheckedOutReason.prefix, String[NIL]];
    IF checkInReason THEN
      plist[5] ← PropertyPair[FALSE, CheckedInReason.prefix, String[NIL]];
    Query[server, fid, plist];
    END;

  GetLibjectQueryInfo: PROCEDURE [fid: FullLibjectIDHandle]
    RETURNS [plist: PropertyList] =
    BEGIN
    plist ← CreatePropertyList[6];
    plist[0] ← PropertyPair[FALSE, CheckedOutBy.prefix, String[NIL]];
    plist[1] ← PropertyPair[FALSE, CheckedOutReason.prefix, String[NIL]];
    plist[2] ← PropertyPair[FALSE, CheckedInReason.prefix, String[NIL]];
    plist[3] ← PropertyPair[FALSE, CheckedInTOD.prefix, TwoWord[Inline.LongNumber[lc[0]]]];
    plist[4] ← PropertyPair[FALSE, CheckedOutTOD.prefix, TwoWord[Inline.LongNumber[lc[0]]]];
    plist[5] ← PropertyPair[FALSE, UserName.prefix, String[NIL]];
    Query[server, fid, plist];
    END;

  WaitForRetry: PROCEDURE [msg: LONG STRING, seconds: CARDINAL] =
    BEGIN
    oldCursor: Cursor.Object;
    ticks: Process.Ticks = Process.SecondsToTicks[1];
    Cursor.Fetch[@oldCursor];
    Cursor.Set[retry];
    WriteString[msg];
    WriteString[".  Will retry."L];
    THROUGH [0..seconds) DO
      Process.Pause[ticks];
      IF UserInput.UserAbort[NetDirBuilderOps.log] THEN
        BEGIN
        PostMessage["  Aborted!"L, NIL, warning];
        Cursor.Store[@oldCursor];
        ERROR Aborted
        END;
      ENDLOOP;
    WriteChar[Ascii.CR];
    Cursor.Store[@oldCursor];
    END;

  -- String Support routines

  PostMessage: PROCEDURE [name, message: LONG STRING, err: ErrorLevel ← info] =
    BEGIN OPEN String;
    SELECT err FROM
      info => NULL;
      warning => {WriteString["Warning, "L]; warnings ← warnings + 1};
      error => {WriteString["Error, "L]; errors ← errors + 1};
      ENDCASE;
    IF name # NIL THEN WriteString[name];
    IF message # NIL THEN {WriteString[": "L]; WriteString[message]};
    WriteChar[Ascii.CR];
    END;

  -- IODefs still lives

  WriteChar: PROCEDURE [c: CHARACTER] =
    BEGIN Put.Char[NetDirBuilderOps.log, c]; END;

  WriteString: PROCEDURE [s: LONG STRING] =
    BEGIN Put.Text[NetDirBuilderOps.log, s]; END;

  WriteLine: PROCEDURE [s: LONG STRING] =
    BEGIN Put.Line[NetDirBuilderOps.log, s]; END;

  END.