MODULEThis code is adapted from Rd.GetLine in DEC SRC's Modula-3 3.6 release.; IMPORT FileAttr, Fmt, FS, Glob, GlobTree, IP, OSError, OSErrorPosix, Pathname, Process, Random, Rd, RdClass, RegEx, SupFileRec, Text, TextArraySort, TextSeq, Thread, TokScan, Uerror; IMPORT TCP; TYPE AtomicCounter = MUTEX OBJECT count: CARDINAL := 0; END; CONST TempStemPrefix = "#cvs.cvsup-"; VAR TempStem: TEXT := NIL; tempCount := NEW(AtomicCounter); RCSSuffixLength := Text.Length(RCSSuffix); portMu := NEW(MUTEX); (* Monitors "portRandom" and "nextPort". *) portRandom: Random.T := NIL; nextPort: IP.Port := IP.NullPort; PROCEDURE SupMisc AtticName (name: Pathname.T): Pathname.T = VAR fileName := PathLast(name); dirName := PathPrefix(name); BEGIN IF Text.Equal(PathLast(dirName), CVSAttic) THEN (* Already in Attic. *) RETURN name; ELSE RETURN CatPath(CatPath(dirName, CVSAttic), fileName); END; END AtticName; PROCEDURECatPath (p1, p2: Pathname.T): Pathname.T = VAR nSlash: [0..2]; BEGIN IF Text.Empty(p1) THEN RETURN p2 END; IF Text.Empty(p2) THEN RETURN p1 END; nSlash := 0; IF Text.GetChar(p1, Text.Length(p1)-1) = SlashChar THEN INC(nSlash) END; IF Text.GetChar(p2, 0) = SlashChar THEN INC(nSlash) END; CASE nSlash OF | 0 => RETURN Cat3(p1, SlashText, p2); | 1 => RETURN p1 & p2; | 2 => RETURN p1 & Text.Sub(p2, 1); END; END CatPath; PROCEDURECheckoutName (name: Pathname.T): Pathname.T = BEGIN (* FIXME - If the name is too short, i.e., not an RCS name, this gets a runtime error. Is that OK? *) RETURN Text.Sub(name, 0, Text.Length(name) - RCSSuffixLength); END CheckoutName; PROCEDURECommonLength (a, b: TEXT): CARDINAL = BEGIN WITH len = MIN(Text.Length(a), Text.Length(b)) DO FOR i := 0 TO len-1 DO IF Text.GetChar(a, i) # Text.GetChar(b, i) THEN RETURN i END; END; RETURN len; END; END CommonLength; PROCEDUREExpandFilenames (prefix: Pathname.T; names: TextSeq.T): TextSeq.T = VAR oldSize := names.size(); newNames: TextSeq.T; arr: REF ARRAY OF TEXT; cur, prev: TEXT; curLen, prevLen: CARDINAL; BEGIN (* Copy the names sequence, expanding wildcards as we go. *) newNames := NEW(TextSeq.T).init(2 * oldSize); FOR i := 0 TO oldSize-1 DO cur := names.get(i); IF Text.FindChar(cur, '*') # -1 OR Text.FindChar(cur, '?') # -1 OR Text.FindChar(cur, '[') # -1 OR Text.FindChar(cur, '{') # -1 THEN (* FIXME - Expand wildcards. *) ELSE TRY IF FS.Status(CatPath(prefix, cur)).type = FS.DirectoryFileType THEN newNames.addhi(cur); ELSE (* FIXME - Handle regular files. *) END; EXCEPT OSError.E => (* Ignore non-existent files. *) END; END; END; (* Copy the expanded list of names into an array, and sort it. *) arr := NEW(REF ARRAY OF TEXT, newNames.size()); FOR i := FIRST(arr^) TO LAST(arr^) DO arr[i] := newNames.get(i); END; TextArraySort.Sort(arr^, PathCompare); (* Copy the sorted array into a new sequence, eliminating overlaps. *) newNames := NEW(TextSeq.T).init(NUMBER(arr^)); prev := NIL; FOR i := FIRST(arr^) TO LAST(arr^) DO cur := arr[i]; curLen := Text.Length(cur); IF prev = NIL OR CommonLength(prev, cur) < prevLen OR curLen > prevLen AND Text.GetChar(cur, prevLen) # SlashChar THEN (* No overlap. *) newNames.addhi(cur); prev := cur; prevLen := curLen; END; END; RETURN newNames; END ExpandFilenames; PROCEDUREFindFile (base: Pathname.T; searchPath: TEXT; file: Pathname.T): Pathname.T = <* FATAL TokScan.Error *> VAR ts := TokScan.New(searchPath, SET OF CHAR{':'}); dir: Pathname.T; path: Pathname.T; BEGIN WHILE ts.next(dir) DO path := ResolvePath(base, ResolvePath(dir, file)); TRY EVAL FileAttr.FromPathname(path, follow := TRUE); RETURN path; EXCEPT OSError.E => (* Keep going. *) END; END; RETURN NIL; END FindFile; PROCEDUREFilterPathList (searchPath: TEXT; cl: TextPredicateClosure): TEXT = <* FATAL TokScan.Error *> VAR dir: TEXT; ts := TokScan.New(searchPath, SET OF CHAR{':'}); res: TEXT := NIL; BEGIN WHILE ts.next(dir) DO IF cl.matches(dir) THEN IF res = NIL THEN res := dir; ELSE res := res & ":" & dir; END; END; END; IF res = NIL THEN res := ""; END; RETURN res; END FilterPathList;
PROCEDUREGetCmdLine (rd: Rd.T): TEXT RAISES {Rd.EndOfFile, Rd.Failure, Thread.Alerted} = VAR txt := ""; j, n: INTEGER; BEGIN RdClass.Lock (rd); TRY LOOP (* INV: txt contains the partial result *) IF rd.cur = rd.hi THEN <* ASSERT NOT rd.closed *> IF rd.seek (rd.cur, FALSE) = RdClass.SeekResult.Eof THEN RAISE Rd.EndOfFile; END; END; (* rd is ready *) n := rd.hi - rd.lo + rd.st; j := rd.cur - rd.lo + rd.st; WHILE (j # n) AND rd.buff[j] # '\n' DO INC(j) END; VAR rd_cur := rd.cur - rd.lo + rd.st; len := j - rd_cur; BEGIN IF len >= 1 AND j # n AND rd.buff[j-1] = '\r' THEN (* segment ends in \r\n *) txt := txt & Text.FromChars (SUBARRAY (rd.buff^, rd_cur, len-1)); INC (rd.cur, len+1); RETURN txt; ELSIF j # n THEN (* segment ends in \n *) txt := txt & Text.FromChars (SUBARRAY (rd.buff^, rd_cur, len)); INC (rd.cur, len+1); IF NOT Text.Empty(txt) AND Text.GetChar(txt, Text.Length(txt)-1) = '\r' THEN txt := Text.Sub(txt, 0, Text.Length(txt)-1) END; RETURN txt; ELSE (* segment does not contain line break *) txt := txt & Text.FromChars (SUBARRAY (rd.buff^, rd_cur, len)); INC (rd.cur, len); END; END; END; (* LOOP *) FINALLY RdClass.Unlock (rd); END; END GetCmdLine; PROCEDUREIsBlankLine (t: TEXT): BOOLEAN = BEGIN FOR i := 0 TO Text.Length(t)-1 DO IF NOT Text.GetChar(t, i) IN SET OF CHAR{' ', '\t', '\r', '\n'} THEN RETURN FALSE; END; END; RETURN TRUE; END IsBlankLine; PROCEDUREIsDirectory (name: Pathname.T): BOOLEAN = BEGIN TRY RETURN FS.Status(name).type = FS.DirectoryFileType; EXCEPT OSError.E => RETURN FALSE; END; END IsDirectory; PROCEDUREIsRCS (p: Pathname.T): BOOLEAN = BEGIN WITH suffixPos = Text.Length(p) - RCSSuffixLength DO IF suffixPos <= 0 THEN RETURN FALSE; END; FOR i := 0 TO RCSSuffixLength-1 DO IF Text.GetChar(p, suffixPos+i) # Text.GetChar(RCSSuffix, i) THEN RETURN FALSE; END; END; RETURN TRUE; END; END IsRCS; PROCEDURELiveName (name: Pathname.T): Pathname.T = VAR fileName := PathLast(name); dirName := PathPrefix(name); BEGIN IF Text.Equal(PathLast(dirName), CVSAttic) THEN RETURN CatPath(PathPrefix(dirName), fileName); ELSE (* Already live. *) RETURN name; END; END LiveName; PROCEDUREMakeDirectories (path: Pathname.T; umask := -1) RAISES {OSError.E} = VAR head := PathPrefix(path); tail: TextSeq.T := NIL; attr := NEW(FileAttr.T).init(FileAttr.FileType.Directory); BEGIN attr := FileAttr.MergeDefault(attr); attr := FileAttr.Umask(attr, umask); (* Successively remove trailing directories until we find a path that exists. *) WHILE NOT Text.Empty(head) DO TRY EVAL FS.Status(head); EXIT; EXCEPT OSError.E(list) => IF OSErrorPosix.AtomToErrno(list.head) = Uerror.ENOENT THEN IF tail = NIL THEN tail := NEW(TextSeq.T).init(30) END; WITH last = PathLast(head) DO (* Without the tests for "Pathname.Current" and empty, we would get a "file exists" error down below when we tried to create the same directory twice. *) IF NOT Text.Equal(last, Pathname.Current) AND NOT Text.Empty(last) THEN tail.addlo(last); END; END; head := PathPrefix(head); ELSE RAISE OSError.E(list); END; END; END; (* Make the needed directories and set their attributes. *) IF tail # NIL THEN WHILE tail.size() > 0 DO head := CatPath(head, tail.remlo()); FileAttr.MakeNode(attr, head); EVAL FileAttr.Install(attr, head); END; END; END MakeDirectories; PROCEDURENewConnector (addr: IP.Address; loPort, hiPort: IP.Port): TCP.Connector RAISES {IP.Error} = VAR ep: IP.Endpoint; firstPort: IP.Port; BEGIN ep.addr := addr; IF hiPort = IP.NullPort THEN hiPort := loPort; ELSIF loPort = IP.NullPort THEN loPort := hiPort; ELSIF loPort > hiPort THEN VAR t := loPort; BEGIN loPort := hiPort; hiPort := t END; END; IF loPort = hiPort THEN ep.port := loPort; RETURN TCP.NewConnector(ep); END; LOCK portMu DO IF NOT (loPort <= nextPort AND nextPort <= hiPort) THEN IF portRandom = NIL THEN (* First call by this process. *) portRandom := NEW(Random.Default).init(); END; nextPort := portRandom.integer(loPort, hiPort); END; firstPort := nextPort; LOOP ep.port := nextPort; IF nextPort >= hiPort THEN nextPort := loPort ELSE INC(nextPort) END; TRY RETURN TCP.NewConnector(ep); EXCEPT IP.Error(list) => IF list.head # IP.PortBusy OR nextPort = firstPort THEN RAISE IP.Error(list); END; END; END; END; END NewConnector; PROCEDUREParseHost (t: TEXT; VAR (*OUT*) res: IP.Address): BOOLEAN RAISES {IP.Error} = BEGIN TRY res := ParseIPAddress(t); RETURN TRUE; EXCEPT BadAddress => RETURN IP.GetHostByName(t, res); END; END ParseHost; PROCEDUREParseIPAddress (t: TEXT; netOK := FALSE): IP.Address RAISES {BadAddress} = CONST Digits = SET OF CHAR{'0'..'9'}; VAR addr: IP.Address; octet: CARDINAL; len := Text.Length(t); pos := 0; BEGIN FOR i := FIRST(addr.a) TO LAST(addr.a) DO IF pos = len THEN (* Default the trailing octets to 0. *) IF NOT netOK THEN RAISE BadAddress END; octet := 0; ELSE IF i # FIRST(addr.a) THEN (* Get the '.' *) IF Text.GetChar(t, pos) # '.' THEN RAISE BadAddress END; INC(pos); IF pos = len THEN RAISE BadAddress END; END; IF NOT Text.GetChar(t, pos) IN Digits THEN RAISE BadAddress END; octet := 0; REPEAT octet := 10*octet + ORD(Text.GetChar(t, pos)) - ORD('0'); INC(pos); UNTIL pos = len OR NOT Text.GetChar(t, pos) IN Digits; IF octet < 0 OR octet > 255 THEN RAISE BadAddress END; END; addr.a[i] := octet; END; IF pos # len THEN RAISE BadAddress END; RETURN addr; END ParseIPAddress; PROCEDUREPathLast (p: Pathname.T): Pathname.T = BEGIN WITH pos = Text.FindCharR(p, SlashChar) DO IF pos = -1 THEN RETURN p; ELSE RETURN Text.Sub(p, pos+1); END; END; END PathLast; PROCEDUREPathPrefix (p: Pathname.T): Pathname.T = BEGIN WITH pos = Text.FindCharR(p, SlashChar) DO IF pos = -1 THEN RETURN ""; ELSIF pos = 0 THEN RETURN SlashText; ELSE RETURN Text.Sub(p, 0, pos); END; END; END PathPrefix; PROCEDUREPatternMatch (pattern: TEXT; options := Glob.MatchOptions{}): GlobTree.T RAISES {RegEx.Error} = BEGIN IF Text.Length(pattern) > 0 AND Text.GetChar(pattern, 0) = '+' THEN (* Remove the '+' and interpret it as a regular expression. *) pattern := Text.Sub(pattern, 1); (* Add anchors at the beginning and end, if needed. *) IF Text.Length(pattern) = 0 OR Text.GetChar(pattern, 0) # '^' THEN pattern := "^" & pattern; END; <* ASSERT Text.Length(pattern) > 0 *> IF Text.GetChar(pattern, Text.Length(pattern) - 1) # '$' THEN pattern := pattern & "$"; END; IF Text.Equal(pattern, "^.*$") THEN RETURN GlobTree.True; END; RETURN GlobTree.RegExMatch(pattern); ELSE (* Treat it as a shell pattern. *) IF Text.Equal(pattern, "*") THEN RETURN GlobTree.True; END; RETURN GlobTree.Match(pattern, options); END; END PatternMatch; PROCEDURERCSName (name: Pathname.T): Pathname.T = BEGIN RETURN name & RCSSuffix; END RCSName; PROCEDUREResolvePath (p1, p2: Pathname.T): Pathname.T = BEGIN IF Pathname.Absolute(p2) THEN RETURN p2; ELSE RETURN CatPath(p1, p2); END; END ResolvePath; PROCEDUREStatusFileName (sfr: SupFileRec.T): Pathname.T = BEGIN RETURN "checkouts" & StatusFileSuffix(sfr); END StatusFileName; PROCEDUREStatusFileSuffix (sfr: SupFileRec.T): TEXT = VAR suffix, tag: TEXT; BEGIN IF sfr.listSuffix # NIL THEN suffix := "." & sfr.listSuffix; ELSIF SupFileRec.Option.UseRelSuffix IN sfr.options THEN suffix := ""; IF sfr.release # NIL THEN suffix := suffix & "." & sfr.release; END; IF SupFileRec.Option.CheckoutMode IN sfr.options THEN tag := sfr.checkoutTag; IF tag = NIL THEN tag := "." END; suffix := suffix & ":" & tag; END; ELSE suffix := ""; END; RETURN suffix; END StatusFileSuffix; PROCEDURETempName (p: Pathname.T): Pathname.T = VAR count: CARDINAL; BEGIN LOCK tempCount DO IF TempStem = NIL THEN (* First call. *) (* We do this here, rather than in the module initialization code, because our process ID may have changed due to forking in "daemon". *) TempStem := TempStemPrefix & Fmt.Int(Process.GetMyID()); END; count := tempCount.count; INC(tempCount.count); END; WITH lastSlash = Text.FindCharR(p, SlashChar), name = TempStem & "." & Fmt.Int(count) DO IF lastSlash = -1 THEN RETURN name; ELSE RETURN Text.Sub(p, 0, lastSlash+1) & name; END; END; END TempName; BEGIN END SupMisc.