MODULE OdAuthBase;
IMPORT OdUtil, WebHTTP, Strings, Files;
CONST
DefaultHost = "webdav.ethz.ch";
AuthDat = "FTP:/WebDAV/es.WebDAVAuth.Dat";
TYPE
Basic * = OBJECT
VAR host * : ARRAY 64 OF CHAR;
pathRealms * : WebHTTP.AdditionalField;
realmAuths * : WebHTTP.AdditionalField;
PROCEDURE & Init(CONST hostStr: ARRAY OF CHAR);
BEGIN
COPY(hostStr, host);
pathRealms := NIL;
realmAuths := NIL;
END Init;
PROCEDURE Allowed(CONST path: ARRAY OF CHAR; auth: ARRAY OF CHAR): BOOLEAN;
VAR realms, auths: OdUtil.Lines;
BEGIN
IF GetAdditionalFieldVals(pathRealms, path, TRUE, realms) THEN
Strings.Trim(auth," ");
IF Strings.Pos("Basic ", auth) = 0 THEN
Strings.Copy(auth, 6, Strings.Length(auth)-6, auth);
WHILE realms # NIL DO
IF GetAdditionalFieldVals(realmAuths, realms.line, FALSE, auths) THEN
WHILE auths # NIL DO
IF auths.line = auth THEN RETURN TRUE; END;
auths := auths.next;
END;
END;
realms := realms.next;
END;
RETURN FALSE;
ELSE
RETURN FALSE;
END;
ELSE
RETURN TRUE;
END;
END Allowed;
PROCEDURE GetChallenge(CONST path: ARRAY OF CHAR; VAR challenges: OdUtil.Lines);
VAR realms: OdUtil.Lines; challenge: OdUtil.Line;
BEGIN
NEW(realms);
NEW(challenges);
IF GetAdditionalFieldVals(pathRealms, path, TRUE, realms) THEN
WHILE realms # NIL DO
Strings.Concat('Basic realm="', realms.line, challenge);
Strings.Append(challenge, '"');
challenges.add(challenge);
realms := realms.next;
END;
ELSE
challenges := NIL;
END;
END GetChallenge;
PROCEDURE Authorized * (VAR req: WebHTTP.RequestHeader; VAR res: WebHTTP.ResponseHeader): BOOLEAN;
CONST PLog = FALSE;
VAR
path, name, authHeader: ARRAY 128 OF CHAR;
challenges: OdUtil.Lines;
BEGIN
IF req.uri = "/" THEN
RETURN FALSE;
END;
OdUtil.unpadColl(req.uri);
Files.SplitPath (req.uri, path, name);
OdUtil.padColl(path);
IF ~WebHTTP.GetAdditionalFieldValue(req.additionalFields, "Authorization", authHeader) THEN
authHeader := "";
END;
IF PLog THEN
OdUtil.Msg6("WebDAVAuthBase.Basic.Authorized: req.uri,path,authHeader =", req.uri, ":", path, ":", authHeader);
END;
IF Allowed(path, authHeader) THEN
IF PLog THEN OdUtil.Msg1("WebDAVAuthBase.Basic.Authorized: TRUE"); END;
RETURN TRUE;
ELSE
res.statuscode := WebHTTP.Unauthorized;
GetChallenge(path, challenges);
ASSERT(challenges # NIL);
WebHTTP.SetAdditionalFieldValue(res.additionalFields, "WWW-Authenticate", challenges.line);
IF PLog THEN OdUtil.Msg1("WebDAVAuthBase.Basic.Authorized: FALSE"); END;
RETURN FALSE;
END;
END Authorized;
END Basic;
VAR
encTable: ARRAY 64 OF CHAR;
decTable: ARRAY 128 OF INTEGER;
defaultAuth * : Basic;
defaultHost * : ARRAY 64 OF CHAR;
PROCEDURE AddAdditionalFieldValue * (VAR af: WebHTTP.AdditionalField; CONST fieldName, value: ARRAY OF CHAR);
VAR a: WebHTTP.AdditionalField;
BEGIN
IF (af = NIL) THEN NEW(a); af := a
ELSE
a := af; WHILE a.next # NIL DO a := a.next END;
NEW(a.next); a := a.next
END;
COPY(fieldName, a.key); COPY(value, a.value)
END AddAdditionalFieldValue;
PROCEDURE GetAdditionalFieldVals * (af: WebHTTP.AdditionalField; CONST fieldName: ARRAY OF CHAR; prefix: BOOLEAN;
VAR values: OdUtil.Lines) : BOOLEAN;
BEGIN
NEW(values);
WHILE af # NIL DO
IF prefix THEN
IF Strings.Pos(af.key, fieldName) = 0 THEN
values.add(af.value);
END;
ELSE
IF af.key = fieldName THEN
values.add(af.value);
END;
END;
af := af.next
END;
IF values # values.next THEN
RETURN TRUE;
ELSE
values := NIL;
RETURN FALSE
END
END GetAdditionalFieldVals;
PROCEDURE InitTables;
VAR i, max: INTEGER;
BEGIN
max := ORD("Z")-ORD("A");
FOR i := 0 TO max DO
encTable[i] := CHR(i+ORD("A"))
END;
INC(max);
FOR i := max TO max+ORD("z")-ORD("a") DO
encTable[i] := CHR(i-max+ORD("a"))
END;
max := max+ORD("z")-ORD("a")+1;
FOR i := max TO max+ORD("9")-ORD("0") DO
encTable[i] := CHR(i-max+ORD("0"))
END;
encTable[62] := "+";
encTable[63] := "/";
FOR i := 0 TO 127 DO
decTable[i] := -1
END;
FOR i := 0 TO 63 DO
decTable[ORD(encTable[i])] := i
END
END InitTables;
PROCEDURE EncodeString * (VAR in, out: ARRAY OF CHAR);
VAR
i, j, c, c0, c1, c2, l: LONGINT;
chars: ARRAY 3 OF CHAR;
inPos, outPos: LONGINT; eos: BOOLEAN;
PROCEDURE OutCode;
BEGIN
IF l > 80 THEN
out[outPos] := 0DX; INC(outPos); l := 0
END;
c0 :=ORD(chars[0]);
c := ASH(c0, -2);
out[outPos] := encTable[c]; INC(outPos); c0 := c0-ASH(c, 2);
c1 := ORD(chars[1]);
c := ASH(c0, 4)+ASH(c1, -4);
out[outPos] := encTable[c]; INC(outPos); c1 := c1 MOD ASH(1, 4);
c2 := ORD(chars[2]);
c := ASH(c1, 2)+ASH(c2, -6);
out[outPos] := encTable[c]; INC(outPos); c2 := c2 MOD ASH(1, 6);
out[outPos] := encTable[c2]; INC(outPos);
INC(l, 4)
END OutCode;
BEGIN
outPos := 0; inPos := 0; eos := FALSE;
l := 0;
chars[0] := in[inPos]; INC(inPos); i := 1;
WHILE ~eos DO
IF i >= 3 THEN
OutCode(); i := 0
END;
chars[i] := in[inPos]; INC(inPos); INC(i);
eos := chars[i-1] = 0X;
END;
DEC(i);
IF i > 0 THEN
j := i;
WHILE i < 3 DO
chars[i] := 0X; INC(i)
END;
OutCode();
out[outPos] := 0X;
IF j < 3 THEN
j := 3-j;
out[outPos-j] := 0X; outPos := outPos-j;
FOR i := 1 TO j DO
out[outPos] := "="; INC(outPos);
END
END
END;
out[outPos] := 0X;
END EncodeString;
PROCEDURE GetAuth * (CONST host: ARRAY OF CHAR): Basic;
BEGIN
RETURN defaultAuth;
END GetAuth;
PROCEDURE SetBasicRealm * (host: ARRAY OF CHAR; CONST realm: ARRAY OF CHAR; path: ARRAY OF CHAR);
BEGIN
IF host = "" THEN COPY(defaultHost, host); END;
OdUtil.padColl(path);
AddAdditionalFieldValue(defaultAuth.pathRealms, path, realm);
END SetBasicRealm;
PROCEDURE SetBasicAuth * (host: ARRAY OF CHAR; CONST realm, user, password: ARRAY OF CHAR);
VAR
userPass, userPass64: ARRAY 64 OF CHAR;
BEGIN
IF host = "" THEN COPY(defaultHost, host); END;
Strings.Concat(user, ":", userPass); Strings.Append(userPass, password);
EncodeString(userPass, userPass64);
AddAdditionalFieldValue(defaultAuth.realmAuths, realm, userPass64);
END SetBasicAuth;
PROCEDURE unquote(VAR str: ARRAY OF CHAR);
BEGIN
IF (str[0] = '"') OR (str[0] = "'") THEN Strings.Copy(str, 1, Strings.Length(str)-2, str); END;
END unquote;
PROCEDURE InitAuths;
VAR f: Files.File; r: Files.Reader;
cmd, host, realm, path, user, password: ARRAY 1024 OF CHAR;
BEGIN
f := Files.Old(AuthDat);
IF f # NIL THEN
NEW(r, f, 0);
LOOP
r.SkipWhitespace; r.Token(cmd);
IF r.res # Files.Ok THEN EXIT END;
IF cmd = "BasicRealm" THEN
r.SkipWhitespace; r.Token(host); IF r.res # Files.Ok THEN EXIT END; unquote(host);
r.SkipWhitespace; r.Token(realm); IF r.res # Files.Ok THEN EXIT END; unquote(realm);
r.SkipWhitespace; r.Token(path); IF r.res # Files.Ok THEN EXIT END; unquote(path);
SetBasicRealm(host, realm, path);
ELSIF cmd = "BasicAuth" THEN
r.SkipWhitespace; r.Token(host); IF r.res # Files.Ok THEN EXIT END; unquote(host);
r.SkipWhitespace; r.Token(realm); IF r.res # Files.Ok THEN EXIT END; unquote(realm);
r.SkipWhitespace; r.Token(user); IF r.res # Files.Ok THEN EXIT END; unquote(user);
r.SkipWhitespace; r.Token(password); IF r.res # Files.Ok THEN EXIT END; unquote(password);
SetBasicAuth(host, realm, user, password);
END;
END
END
END InitAuths;
BEGIN
InitTables;
defaultHost := DefaultHost;
NEW(defaultAuth, defaultHost);
InitAuths;
END OdAuthBase.