MODULE*************************************************************************** The remaining procedures are used only for debugging. ***************************************************************************; IMPORT ErrMsg, File, FileRd, Fmt, FS, IP, Logger, OSError, OSErrorPosix, Pathname, Rd, RefList, SupMisc, Text, Thread, Time, Uerror, UnixMisc, Word; REVEAL T = BRANDED OBJECT path: Pathname.T := ""; logger: Logger.T := NIL; fileTime: Time.T := 0.0d0; refreshTime: Time.T := 0.0d0; rules: RefList.T := NIL; (* List of Rule. *) END; TYPE RuleType = { Permit, PermitWithAuth, Deny }; Rule = OBJECT addr: IP.Address; matchBits: CARDINAL; countBits: CARDINAL; type: RuleType; limit: CARDINAL; END; CONST Digits = SET OF CHAR{'0'..'9'}; VAR (* CONST *) EnoentAtom := OSErrorPosix.ErrnoAtom(Uerror.ENOENT); VAR theT := NEW(T); EXCEPTION Error(TEXT); PROCEDURE AccessRules Check (rules: T; addr: IP.Address; READONLY clients: ARRAY OF IP.Address): CheckResult = VAR cur: RefList.T; rule: Rule; count: CARDINAL; BEGIN cur := rules.rules; WHILE cur # NIL DO rule := cur.head; IF Match(addr, rule.addr, rule.matchBits) THEN count := 0; FOR i := FIRST(clients) TO LAST(clients) DO IF clients[i] # IP.NullAddress AND Match(addr, clients[i], rule.countBits) THEN INC(count); END; END; IF count > rule.limit THEN (* Failed the rule. *) IF rule.type = RuleType.Deny THEN IF rule.limit = 0 THEN RETURN CheckResult.Denied; ELSE RETURN CheckResult.TooMany; END; END; ELSE (* Passed the rule. *) IF rule.type = RuleType.Permit THEN RETURN CheckResult.OK; ELSIF rule.type = RuleType.PermitWithAuth THEN RETURN CheckResult.AuthRequired; END; END; END; cur := cur.tail; END; (* If we fall off the end, we accept. This is used only when there is no readable access file. If the access file exists and is readable, we automatically append a universal deny rule to the end. *) RETURN CheckResult.OK; END Check; PROCEDUREGet (path: Pathname.T; maxAge: Time.T; logger: Logger.T := NIL): T RAISES {Rd.Failure, Thread.Alerted} = CONST HostStop = SET OF CHAR{' ', '\t', '/', '\n'}; WS = SET OF CHAR{' ', '\t'}; VAR now := Time.Now(); file: File.T; rd: Rd.T; fileTime: Time.T; line: TEXT; lineNum: CARDINAL; len: CARDINAL; scanPos: CARDINAL; chPos: CARDINAL; start: CARDINAL; ch: CHAR; type: RuleType; host: TEXT; matchBits: CARDINAL; countBits: CARDINAL; limit: CARDINAL; lastRule: RefList.T; PROCEDURE AddRule(addr: IP.Address; matchBits: CARDINAL; countBits: CARDINAL; type: RuleType; limit: CARDINAL) = VAR rule := NEW(Rule, addr := addr, matchBits := matchBits, countBits := countBits, type := type, limit := limit); elem := RefList.List1(rule); BEGIN IF lastRule = NIL THEN theT.rules := elem; ELSE lastRule.tail := elem; END; lastRule := elem; END AddRule; PROCEDURE NextCh() = BEGIN chPos := scanPos; IF scanPos < len THEN ch := Text.GetChar(line, chPos); INC(scanPos); ELSE ch := '\n'; END; END NextCh; PROCEDURE SkipWS() = BEGIN WHILE ch IN WS DO NextCh(); END; END SkipWS; BEGIN (* We go ahead and open the file even though we might not need to parse it. That way we avoid races between a stat() and the subsequent open. *) TRY file := FS.OpenFileReadonly(path); rd := NEW(FileRd.T).init(file); EXCEPT OSError.E(list) => IF list.head # EnoentAtom THEN Log(logger, Logger.Priority.Warning, "Cannot open \"" & path & "\": " & ErrMsg.StrError(list)); END; theT.path := ""; theT.logger := logger; theT.fileTime := 0.0d0; theT.refreshTime := 0.0d0; theT.rules := NIL; RETURN theT; END; TRY TRY fileTime := file.status().modificationTime; EXCEPT OSError.E(list) => (* No way! *) Log(logger, Logger.Priority.Warning, "fstat failed on \"" & path & "\": " & ErrMsg.StrError(list)); fileTime := 0.0d0; END; (* No need to reparse the file (with potential DNS delays) if what we have already is up to date. *) IF Text.Equal(path, theT.path) AND theT.fileTime = fileTime AND theT.refreshTime >= now - maxAge THEN RETURN theT; END; theT.path := path; theT.logger := logger; theT.fileTime := fileTime; theT.refreshTime := now; theT.rules := NIL; lastRule := NIL; lineNum := 0; LOOP TRY line := Rd.GetLine(rd) EXCEPT Rd.EndOfFile => EXIT END; INC(lineNum); WITH commentStart = Text.FindChar(line, '#') DO IF commentStart >= 0 THEN line := Text.Sub(line, 0, commentStart); END; END; len := Text.Length(line); scanPos := 0; NextCh(); SkipWS(); IF ch # '\n' THEN (* Line has something on it. *) TRY (* Scan the rule type. *) CASE ch OF | '+' => type := RuleType.Permit; limit := LAST(CARDINAL); | '*' => type := RuleType.PermitWithAuth; limit := LAST(CARDINAL); | '-' => type := RuleType.Deny; limit := 0; ELSE RAISE Error("\"+\" or \"-\" expected"); END; NextCh(); SkipWS(); (* Scan the host name or IP address. *) start := chPos; WHILE NOT ch IN HostStop DO NextCh() END; IF chPos = start THEN RAISE Error("Host name or IP address expected"); END; host := Text.Sub(line, start, chPos - start); SkipWS(); (* Scan the match bits, if any. The default is 32. *) matchBits := 32; IF ch = '/' THEN (* Match bits *) NextCh(); SkipWS(); IF NOT ch IN Digits THEN RAISE Error("Invalid matchbits"); END; matchBits := 0; REPEAT matchBits := 10*matchBits + ORD(ch) - ORD('0'); NextCh(); UNTIL NOT ch IN Digits; IF matchBits > 32 THEN RAISE Error("Matchbits (" & Fmt.Int(matchBits) & ") out of range"); END; SkipWS(); END; (* Scan the count bits, if any. The default is the match bits. *) countBits := matchBits; IF ch = '/' THEN (* Count bits *) NextCh(); SkipWS(); IF NOT ch IN Digits THEN RAISE Error("Invalid countbits"); END; countBits := 0; REPEAT countBits := 10*countBits + ORD(ch) - ORD('0'); NextCh(); UNTIL NOT ch IN Digits; IF countBits > 32 THEN RAISE Error("Countbits (" & Fmt.Int(countBits) & ") out of range"); END; SkipWS(); END; (* Scan the connection limit, if any. The default was set above, based on the rule type. *) IF ch # '\n' THEN IF NOT ch IN Digits THEN RAISE Error("Invalid connection limit"); END; limit := 0; REPEAT limit := 10*limit + ORD(ch) - ORD('0'); NextCh(); UNTIL NOT ch IN Digits; SkipWS(); END; IF ch # '\n' THEN RAISE Error("End of line expected") END; TRY AddRule(SupMisc.ParseIPAddress(host, netOK := TRUE), matchBits, countBits, type, limit); EXCEPT SupMisc.BadAddress => (* Try it as a host name. *) WITH addrs = UnixMisc.GetHostAddrs(host) DO IF addrs = NIL OR NUMBER(addrs^) = 0 THEN RAISE Error("Cannot resolve host name \"" & host & "\""); END; FOR i := FIRST(addrs^) TO LAST(addrs^) DO AddRule(addrs[i], matchBits, countBits, type, limit); END; END; END; EXCEPT Error(msg) => Log(logger, Logger.Priority.Warning, path & ":" & Fmt.Int(lineNum) & ": " & msg); END; END; END; (* Append a universal PermitWithAuth rule at the end. *) AddRule(IP.NullAddress, 0, 0, RuleType.PermitWithAuth, LAST(CARDINAL)); FINALLY Rd.Close(rd); END; RETURN theT; END Get; PROCEDURELog (logger: Logger.T; priority: Logger.Priority; msg: TEXT) = BEGIN IF logger # NIL THEN Logger.Put(logger, priority, msg); END; END Log; PROCEDUREMatch (addr1, addr2: IP.Address; maskBits: CARDINAL): BOOLEAN = CONST Masks = ARRAY [1..7] OF INTEGER{ 16_80, 16_c0, 16_e0, 16_f0, 16_f8, 16_fc, 16_fe }; VAR i := 0; BEGIN WHILE maskBits >= 8 DO IF addr1.a[i] # addr2.a[i] THEN RETURN FALSE END; INC(i); DEC(maskBits, 8); END; IF maskBits > 0 THEN WITH m = Masks[maskBits] DO IF Word.And(addr1.a[i], m) # Word.And(addr2.a[i], m) THEN RETURN FALSE; END; END; END; RETURN TRUE; END Match;
PROCEDUREFmtIP (addr: IP.Address): TEXT =
Used only for debugging.
VAR t := Fmt.Int(addr.a[0]); BEGIN FOR i := 1 TO LAST(addr.a) DO t := t & "." & Fmt.Int(addr.a[i]); END; RETURN t; END FmtIP; <*UNUSED*> PROCEDUREFmtRule (rule: Rule): TEXT =
Used only for debugging.
VAR t: TEXT; BEGIN CASE rule.type OF | RuleType.Permit => t := "+"; | RuleType.PermitWithAuth => t := "*"; | RuleType.Deny => t := "-"; END; t := t & FmtIP(rule.addr); t := t & "/" & Fmt.Int(rule.matchBits); t := t & "/" & Fmt.Int(rule.countBits); t := t & " " & Fmt.Int(rule.limit); RETURN t; END FmtRule; BEGIN END AccessRules.