<> <> DIRECTORY Ascii USING [BS, ControlA, ControlQ, ControlW, ControlX, CR, DEL, Digit, Letter, SP], BasicTime USING [GMT, nullGMT, Period], Booting USING [RegisterProcs, RollbackProc, switches], DFOperations USING [ BringOver, ChoiceInteraction, ChoiceResponse, Choices, DFInfoInteraction, FileInteraction, InfoInteraction, InteractionProc, YesNoInteraction, YesNoResponse], DFUtilities USING [DateToRope], FS USING [ComponentPositions, Copy, Error, ExpandName, FileInfo, StreamOpen], GermSwap USING [Switch], IO USING [ card, Close, EndOfStream, Error, GetChar, GetTime, GetTokenRope, EraseChar, IDProc, PutChar, PutF, PutFR, PutRope, rope, STREAM], Process USING [SecondsToTicks], Rope USING [Cat, Concat, Equal, Fetch, FromChar, Length, ROPE, SkipTo, Substr], SimpleTerminal USING [InputTimeout, SetInputTimeout, TurnOff, TurnOn], SystemVersion USING [release], Terminal USING [BlinkBWDisplay, Current], UserCredentials USING [Get], UserProfile USING [ListOfTokens, ProfileChanged]; InstallerImpl: CEDAR PROGRAM IMPORTS Ascii, BasicTime, Booting, DFOperations, DFUtilities, FS, IO, Process, Rope, SimpleTerminal, SystemVersion, Terminal, UserCredentials, UserProfile = BEGIN OPEN DFOps: DFOperations, DFUtils: DFUtilities; ROPE: TYPE = Rope.ROPE; in, out: IO.STREAM; <> <<>> GetChoice: PROC [c: REF DFOps.ChoiceInteraction] RETURNS [choice: NAT] = { DO default: ROPE = c.choices[choice _ c.default]; ans: ROPE _ NIL; firstChar: BOOL _ TRUE; FlushVisible: PROC = { r: ROPE = IF firstChar THEN default ELSE ans; FOR i: INT DECREASING IN [0..r.Length[]) DO out.EraseChar[r.Fetch[i]]; ENDLOOP; ans _ NIL; choice _ c.default; firstChar _ FALSE; }; THROUGH [0..2*depth) DO out.PutChar[Ascii.SP]; ENDLOOP; out.PutRope[c.message]; out.PutChar[Ascii.SP]; out.PutRope[default]; DO oldAns: ROPE = ans; char: CHAR; char _ in.GetChar[ ! SimpleTerminal.InputTimeout => {char _ Ascii.CR; CONTINUE}]; SELECT char FROM Ascii.DEL => {out.PutRope[" XXX\N"]; GO TO startOver}; Ascii.CR => IF ans.Length[] = 0 THEN GO TO done; Ascii.BS, Ascii.ControlA => IF firstChar THEN FlushVisible[] ELSE IF ans.Length[] > 0 THEN { out.EraseChar[ans.Fetch[ans.Length[]-1]]; ans _ ans.Substr[len: ans.Length[]-1]; }; Ascii.ControlQ, Ascii.ControlW, Ascii.ControlX => FlushVisible[]; '? => { out.PutRope[" XXX\NChoices are: "]; FOR i: NAT IN [0..c.choices.length) DO IF i ~= 0 THEN out.PutRope[", "]; out.PutRope[c.choices[i]]; ENDLOOP; out.PutChar[Ascii.CR]; IF c.explanations ~= NIL THEN FOR i: NAT IN [0..c.explanations.length) DO IF c.explanations[i] ~= NIL THEN { out.PutRope[c.explanations[i]]; out.PutChar[Ascii.CR]; }; ENDLOOP; GO TO startOver }; ENDCASE => { state: {notFound, found, ambiguous} _ notFound; IF firstChar THEN FlushVisible[]; ans _ ans.Concat[Rope.FromChar[char]]; FOR i: NAT IN [0..c.choices.length) DO IF ans.Equal[s2: c.choices[i].Substr[len: ans.Length[]], case: FALSE] THEN { IF ans.Length[] = c.choices[i].Length[] THEN {choice _ i; state _ found; EXIT}; SELECT state FROM notFound => {choice _ i; state _ found}; found => state _ ambiguous; ENDCASE; }; ENDLOOP; SELECT state FROM notFound => { Terminal.BlinkBWDisplay[Terminal.Current[]]; ans _ oldAns; }; found => { out.PutRope[c.choices[choice].Substr[start: oldAns.Length[]]]; GO TO done }; ambiguous => out.PutChar[c.choices[choice].Fetch[oldAns.Length[]]]; ENDCASE; }; REPEAT startOver => NULL; ENDLOOP; REPEAT done => NULL; ENDLOOP; out.PutChar[Ascii.CR]; }; Confirm: PROC [message: ROPE, default: BOOL _ TRUE] RETURNS [BOOL] = { c: REF DFOps.ChoiceInteraction = NEW[DFOps.ChoiceInteraction _ [ message: message, choices: yesNo, explanations: NIL, default: default.ORD ]]; OpenTerminal[]; RETURN[VAL[GetChoice[c]]] }; autoConfirm: BOOL _ TRUE; depth: INT _ -1; Interact: DFOps.InteractionProc = { WITH interaction SELECT FROM info: REF DFOps.InfoInteraction => { prompt: BOOL _ TRUE; THROUGH [0..2*depth) DO out.PutChar[Ascii.SP]; ENDLOOP; SELECT info.class FROM info => prompt _ FALSE; warning => out.PutRope["Warning: "]; error => out.PutRope["Error: "]; abort => NULL; ENDCASE; out.PutRope[info.message]; out.PutChar[Ascii.CR]; IF prompt THEN { IF Confirm["Shall I continue anyway?"] THEN RETURN; out.PutRope["Giving up..."]; Die[]; }; }; info: REF DFOps.DFInfoInteraction => { SELECT info.action FROM start => { depth _ depth.SUCC; THROUGH [0..2*depth) DO out.PutChar[Ascii.SP]; ENDLOOP; out.PutRope["BringOver of "]; out.PutRope[info.dfFile]; }; end => { THROUGH [0..2*depth) DO out.PutChar[Ascii.SP]; ENDLOOP; out.PutRope["End BringOver of "]; out.PutRope[info.dfFile]; depth _ depth.PRED; }; abort => { out.PutRope["BringOver of "]; out.PutRope[info.dfFile]; out.PutRope[" aborted"]; depth _ -1; }; ENDCASE; IF info.message ~= NIL THEN out.PutF[" (%g)", IO.rope[info.message]]; out.PutChar[Ascii.CR]; }; c: REF DFOps.ChoiceInteraction => RETURN[response: NEW[DFOps.ChoiceResponse _ [GetChoice[c]]]]; yn: REF DFOps.YesNoInteraction => IF ~autoConfirm THEN { c: REF DFOps.ChoiceInteraction = NEW[DFOps.ChoiceInteraction _ [ message: yn.message, choices: ynqa, explanations: NIL, default: IF yn.default THEN YNQA.yes.ORD ELSE YNQA.no.ORD ]]; choice: YNQA = VAL[GetChoice[c]]; SELECT choice FROM $yes => RETURN[response: NEW[DFOps.YesNoResponse _ [TRUE]]]; $no => RETURN[response: NEW[DFOps.YesNoResponse _ [FALSE]]]; $quit => { abort _ TRUE; abortMessageForLog _ "(requested by user)"; }; $all => { autoConfirm _ TRUE; RETURN[response: NEW[DFOps.YesNoResponse _ [TRUE]]] }; ENDCASE; }; file: REF DFOps.FileInteraction => IF autoConfirm THEN { THROUGH [0..2*depth) DO out.PutChar[Ascii.SP]; ENDLOOP; out.PutF["%g %g %g {%g}%g\N", IO.rope[file.localFile], IO.rope[ SELECT file.action FROM $fetch => "<--", $store => "-->", $check => "<-->", ENDCASE => NIL], IO.rope[file.remoteFile], IO.rope[DFUtils.DateToRope[[$explicit, file.date]]], IO.rope[ IF file.dateFormat = $explicit THEN NIL ELSE IO.PutFR[" ('%g')", SELECT file.dateFormat FROM $greaterThan => [character['>]], $notEqual => [rope["~="]], ENDCASE => [null[]] ] ] ]; }; ENDCASE; }; Rubout: ERROR = CODE; GetID: PROC [default: ROPE, echo: BOOL _ TRUE] RETURNS [id: ROPE] = { OPEN Ascii; firstTime: BOOL _ TRUE; c: CHAR; EraseAll: PROC = { IF echo THEN FOR i: INT DECREASING IN [0..id.Length[]) DO out.EraseChar[id.Fetch[i]]; ENDLOOP; id _ NIL; }; Done: PROC [c: CHAR] RETURNS [BOOL] = INLINE { IF firstTime THEN { SELECT c FROM ControlA, BS, ControlQ, ControlW, ControlX, CR, SP => NULL; ENDCASE => EraseAll[]; firstTime _ FALSE; }; RETURN[c = SP OR c = CR] }; id _ default; IF echo THEN out.PutRope[default]; c _ in.GetChar[ ! SimpleTerminal.InputTimeout => --RETURN--GO TO defaultReturn]; UNTIL Done[c] DO SELECT c FROM DEL => {out.PutRope[" XXX\N"]; ERROR Rubout}; ControlA, BS => { len: INT _ id.Length[]; IF len > 0 THEN { len _ len - 1; IF echo THEN out.EraseChar[id.Fetch[len]]; id _ id.Substr[len: len]; }; }; ControlW, ControlQ => { <, the and following are to be removed.>> alpha: BOOL _ FALSE; FOR i: INT DECREASING IN [0..id.Length[]) DO ch: CHAR = id.Fetch[i]; IF Ascii.Letter[ch] OR Ascii.Digit[ch] THEN alpha _ TRUE ELSE IF alpha THEN {id _ id.Substr[len: i + 1]; EXIT}; IF echo THEN out.EraseChar[ch]; REPEAT FINISHED => id _ NIL; ENDLOOP; }; ControlX => EraseAll[]; ENDCASE => {id _ id.Concat[Rope.FromChar[c]]; IF echo THEN out.PutChar[c]}; c _ in.GetChar[ ! SimpleTerminal.InputTimeout => RESUME]; ENDLOOP; EXITS defaultReturn => NULL; }; <> <> <>> <)>> <<(UserDF: name and date of (remote) user-specified DF and date ) ...>> FileDesc: TYPE = RECORD [name: ROPE _ NIL, date: BasicTime.GMT _ BasicTime.nullGMT]; DFList: TYPE = REF DFListObject; DFListObject: TYPE = RECORD [head: LIST OF FileDesc _ NIL, tail: LIST OF FileDesc _ NIL]; systemID: ROPE = IO.PutFR["%g.%g.%g", IO.card[SystemVersion.release.major], IO.card[SystemVersion.release.minor], IO.card[SystemVersion.release.patch] ]; stamp: FileDesc _ []; longDialogue: BOOL _ Booting.switches[l]; development: BOOL _ Booting.switches[d]; haveEssentials: BOOL _ FALSE; haveProfile: BOOL _ FALSE; essentials: FileDesc _ []; profile: FileDesc _ []; profileDFList: DFList = NEW[DFListObject _ []]; newProfileDFList: DFList = NEW[DFListObject _ []]; ParseInstallationStamp: PROC = { ForgetStamp[]; stamp _ TryFile[Rope.Concat["InstallationStamp.", systemID]].desc; IF stamp.date ~= BasicTime.nullGMT THEN { in: IO.STREAM = FS.StreamOpen[stamp.name ! FS.Error => GO TO noStamp]; GetFileDesc: PROC RETURNS [FileDesc] = { RETURN[[ name: StripVersion[in.GetTokenRope[IO.IDProc].token], date: in.GetTime[] ]] }; DO ENABLE IO.EndOfStream, IO.Error, FS.Error => GO TO parsingProblem; itemName: ROPE = in.GetTokenRope[IO.IDProc ! IO.EndOfStream => EXIT].token; SELECT TRUE FROM itemName.Equal["Essentials"] => IF essentials.name = NIL THEN essentials _ GetFileDesc[] ELSE GO TO parsingProblem; itemName.Equal["Profile"] => IF profile.name = NIL THEN profile _ GetFileDesc[] ELSE GO TO parsingProblem; itemName.Equal["UserDF"] => AddToDFList[profileDFList, GetFileDesc[]]; ENDCASE => GO TO parsingProblem; REPEAT parsingProblem => {in.Close[]; GO TO noStamp}; ENDLOOP; in.Close[]; }; EXITS noStamp => ForgetStamp[]; }; WriteStamp: PROC = { out: IO.STREAM = FS.StreamOpen[StripVersion[stamp.name], $create ! FS.Error => GO TO noStamp]; PutFileDesc: PROC [head: ROPE, desc: FileDesc] = { out.PutF["%g: %g %g\N", IO.rope[head], IO.rope[desc.name], IO.rope[DFUtils.DateToRope[[$explicit, desc.date]]] ]; }; PutFileDesc["Essentials", essentials]; IF profile.name ~= NIL AND profile.date ~= BasicTime.nullGMT THEN PutFileDesc["Profile", profile]; FOR l: LIST OF FileDesc _ newProfileDFList.head, l.rest UNTIL l = NIL DO IF l.first.date ~= BasicTime.nullGMT THEN PutFileDesc["UserDF", l.first]; ENDLOOP; out.Close[]; stamp _ []; EXITS noStamp => NULL; }; ForgetStamp: PROC = { essentials _ profile _ []; profileDFList^ _ []; }; FindBootEssentials: PROC = { <> DO <> IF longDialogue OR development THEN haveEssentials _ Confirm["Shall I assume the local files essential for booting are current?", FALSE]; IF ~haveEssentials THEN { name: ROPE = Rope.Cat["BootEssentials.", systemID, ".df"]; path: ROPE = Rope.Cat["[Indigo]<", IF development THEN "PreCedar" ELSE "Cedar", ">Top>"]; desc: FileDesc _ TryFile[name, path].desc; SELECT TRUE FROM desc.date ~= BasicTime.nullGMT => haveEssentials _ essentials.date = desc.date AND essentials.name.Equal[StripVersion[desc.name], FALSE]; ~development AND (development _ Confirm["Did you mean to boot with the 'D' switch?"]) => { Booting.switches[d] _ TRUE; out.PutRope["(D-switch now set.)\N"]; LOOP }; ENDCASE => WHILE Confirm["Do you want to specify a DF file for booting essentials?"] DO fileName: ROPE = FS.ExpandName[name, Rope.Cat["[Ivy]<", user, ">"]].fullFName; out.PutRope["DF file for booting essentials: "]; desc _ TryFile[GetID[fileName ! Rubout => LOOP]].desc; IF desc.date = BasicTime.nullGMT THEN out.PutRope["...not found\N"] ELSE {out.PutChar[Ascii.CR]; EXIT}; REPEAT FINISHED => { out.PutRope["The files essential for booting can't be found. I give up.\N"]; Die[]; }; ENDLOOP; essentials _ desc; }; EXIT ENDLOOP; }; FindUserProfile: PROC = { <> localDesc: FileDesc; attachedTo: ROPE; [localDesc, attachedTo] _ TryFile[localProfile]; SELECT TRUE FROM localDesc.date = BasicTime.nullGMT => { <> installIfTimeout: BOOL _ TRUE; WHILE Confirm["Do you wish to install a personal profile?", installIfTimeout] DO <> profileName: ROPE _ IF profile.name ~= NIL THEN profile.name ELSE Rope.Cat["[Ivy]<", user, ">", localProfile]; remote: FileDesc _ []; out.PutRope[" Personal profile name: "]; remote _ TryFile[GetID[profileName ! Rubout => LOOP]].desc; IF remote.date = BasicTime.nullGMT THEN { out.PutRope["...not found\N"]; installIfTimeout _ ~remote.name.Equal[profileName]; } ELSE { out.PutChar[Ascii.CR]; profile _ remote; FS.Copy[from: profile.name, to: localProfile, keep: 2, attach: TRUE]; EXIT }; ENDLOOP; }; profile.name = NIL => { <> haveProfile _ TRUE; -- assume the local disk is good enough. IF attachedTo ~= NIL THEN profile _ [attachedTo, localDesc.date]; }; ENDCASE => { <> remote: FileDesc _ TryFile[StripVersion[profile.name]].desc; haveProfile _ localDesc.date = remote.date; IF ~haveProfile AND remote.date ~= BasicTime.nullGMT THEN { msg: ROPE = IO.PutFR["Shall I install %g {%g} as your profile?", IO.rope[remote.name], IO.rope[DFUtils.DateToRope[[$explicit, remote.date]]] ]; IF Confirm[msg, BasicTime.Period[from: localDesc.date, to: remote.date] > 0] THEN { FS.Copy[from: remote.name, to: localProfile, keep: 2, attach: TRUE]; profile _ remote; }; }; }; }; BringOverUserDFs: PROC = { dfNames: LIST OF ROPE _ UserProfile.ListOfTokens["Installation.BringOver"]; IF longDialogue THEN SELECT TRUE FROM dfNames ~= NIL AND Confirm["Shall I ignore the profile's list of DF files to bring over?", FALSE] => dfNames _ NIL; profileDFList.head ~= NIL AND Confirm["Shall I ignore DF files previously brought over?", FALSE] => profileDFList^ _ []; ENDCASE; newProfileDFList^ _ []; FOR dfList: LIST OF ROPE _ dfNames, dfList.rest UNTIL dfList = NIL DO desc: FileDesc = TryFile[dfList.first].desc; IF InDFList[profileDFList, desc] THEN { out.PutF["%g {%g} previously brought over.\N", IO.rope[desc.name], IO.rope[DFUtils.DateToRope[[$explicit, desc.date]]] ]; AddToDFList[newProfileDFList, desc]; } ELSE { e, w: INT; CheckAutoConfirm[desc.name]; [errors: e, warnings: w] _ DFOps.BringOver[dfFile: desc.name, filter: [filterB: $public], interact: Interact]; IF e + w = 0 THEN AddToDFList[newProfileDFList, desc]; }; ENDLOOP; }; InDFList: PROC [list: DFList, desc: FileDesc] RETURNS [BOOL _ FALSE] = { FOR l: LIST OF FileDesc _ list.head, l.rest UNTIL l = NIL DO IF l.first.date = desc.date AND StripVersion[desc.name].Equal[StripVersion[l.first.name], FALSE] THEN RETURN[TRUE]; ENDLOOP; }; AddToDFList: PROC [list: DFList, desc: FileDesc] = { descL: LIST OF FileDesc = CONS[desc, NIL]; IF list.head = NIL THEN list.head _ descL ELSE list.tail.rest _ descL; list.tail _ descL; }; <> installedUser: ROPE; user: ROPE; localProfile: ROPE; InitUserRelatedInfo: PROC = { installedUser _ UserCredentials.Get[].name; user _ installedUser.Substr[len: installedUser.SkipTo[skip: "."]]; localProfile _ user.Concat[".profile"]; }; OpenTerminal: PROC = { IF in ~= NIL THEN RETURN; [in, out] _ SimpleTerminal.TurnOn[]; out.PutChar[Ascii.CR]; }; CloseTerminal: PROC = { IF in = NIL THEN RETURN; SimpleTerminal.TurnOff[]; in _ out _ NIL; }; TryFile: PROC [shortName, prefix: ROPE _ NIL] RETURNS [desc: FileDesc _ [], attachedTo: ROPE _ NIL] = { desc.name _ FS.ExpandName[name: shortName, wDir: prefix].fullFName; [fullFName: desc.name, attachedTo: attachedTo, created: desc.date] _ FS.FileInfo[name: desc.name ! FS.Error => CONTINUE]; }; StripVersion: PROC [old: ROPE] RETURNS [new: ROPE] = { cp: FS.ComponentPositions; [fullFName: new, cp: cp] _ FS.ExpandName[old]; new _ new.Substr[len: cp.ext.start+cp.ext.length]; }; CheckAutoConfirm: PROC [df: ROPE] = { IF (longDialogue OR development) AND autoConfirm THEN { msg: ROPE = Rope.Cat["Do you wish to confirm retrieval of each file from ", df, " individually?"]; autoConfirm _ ~Confirm[msg, FALSE]; }; }; Die: PROC = {DO ENDLOOP}; <<>> <<>> <
> NewUser: Booting.RollbackProc = { IF ~UserCredentials.Get[].name.Equal[installedUser, FALSE] THEN DoRealWork[]; }; DoRealWork: PROC = { haveEssentials _ haveProfile _ FALSE; IF longDialogue AND ~Confirm["Long installation dialogue [confirm] "] THEN { out.PutRope["(L-switch now cleared.)\N"]; longDialogue _ Booting.switches[l] _ FALSE; }; IF ~longDialogue THEN SimpleTerminal.SetInputTimeout[Process.SecondsToTicks[30]]; InitUserRelatedInfo[]; ParseInstallationStamp[]; FindBootEssentials[]; FindUserProfile[]; IF ~haveEssentials THEN { CheckAutoConfirm[essentials.name]; [] _ DFOps.BringOver[dfFile: essentials.name, interact: Interact, action: fetch]; }; IF ~haveProfile THEN UserProfile.ProfileChanged[rollBack]; BringOverUserDFs[]; WriteStamp[]; SimpleTerminal.SetInputTimeout[0]; CloseTerminal[]; }; YNQA: TYPE = {yes, no, quit, all}; ynqa: REF DFOps.Choices = NEW[DFOps.Choices[YNQA.LAST.ORD.SUCC - YNQA.FIRST.ORD]]; yesNo: REF DFOps.Choices = NEW[DFOps.Choices[BOOL.LAST.ORD.SUCC - BOOL.FIRST.ORD]]; yesNo[BOOL.TRUE.ORD] _ "Yes"; yesNo[BOOL.FALSE.ORD] _ "No"; ynqa[YNQA.yes.ORD] _ "Yes"; ynqa[YNQA.no.ORD] _ "No"; ynqa[YNQA.quit.ORD] _ "Quit"; ynqa[YNQA.all.ORD] _ "All"; IF Booting.switches ~= [] THEN { OpenTerminal[]; out.PutRope["\NBoot switches:"]; FOR sw: GermSwap.Switch IN GermSwap.Switch DO IF Booting.switches[sw] THEN { out.PutChar[Ascii.SP]; out.PutChar[VAL[(IF sw <= nine THEN '0 ELSE 'A-10)+sw.ORD]]; }; ENDLOOP; out.PutChar[Ascii.CR]; }; DoRealWork[]; installedUser _ UserCredentials.Get[].name; Booting.RegisterProcs[r: NewUser]; END.