The Trunk: WebClient-Core-topa.114.mcz

Tobias Pape uploaded a new version of WebClient-Core to project The Trunk:
http://source.squeak.org/trunk/WebClient-Core-topa.114.mcz

==================== Summary ====================

Name: WebClient-Core-topa.114
Author: topa
Time: 28 March 2018, 9:49:17.368144 pm
UUID: 6f483d27-959e-49ce-8a4b-2e825409953b
Ancestors: WebClient-Core-ul.113

Support token-based Bearer/OAuth2 auth.

Note: server part is overly simplified and surely needs extensions for proper OAuth2

=============== Diff against WebClient-Core-ul.113 ===============

Item was added:
+ ----- Method: WebAuthRequired>>token: (in category 'initialize') -----
+ token: aString
+ "Use the given token as credentials"
+
+ | params |
+ params := self isProxyAuth ifTrue:[client proxyParams] ifFalse:[client authParams].
+
+ (params at: #token ifAbsent: [nil]) = aString
+ ifFalse:
+ [params at: #token put: aString.
+ self resume: true]
+ !

Item was changed:
  ----- Method: WebClient>>authDispatch:from:header:params: (in category 'authentication') -----
  authDispatch: request from: response header: authHeader params: params
  "Dispatch on an authentication method.
  Subclasses can extend this method to support more auth methods."
 
  (authHeader copyUpTo: Character space) caseOf: {
  ['Basic'] -> [self basicAuth: request from: response
  header: authHeader params: params].
  ['Digest'] -> [self digestAuth: request from: response
  header: authHeader  params: params].
+ ['Bearer'] -> [self bearerAuth: request from: response
+ header: authHeader params: params].
  } otherwise:["ignore"].
  !

Item was added:
+ ----- Method: WebClient>>bearerAuth:from:header:params: (in category 'authentication') -----
+ bearerAuth: request from: response header: header params: params
+ "Provide token-based OAuth2 authentication for the request"
+
+ | token args |
+ authParams at: #authMethod ifPresent:[:method| ^self]. "do not retry repeatedly"
+ authParams at: #authMethod put: 'Bearer'.
+
+ args := WebUtils parseAuthParams: header.
+ args at: 'realm' ifPresent:[:realm| authParams at: #authRealm put: realm].
+
+ token := (params at: #token ifAbsent:[nil]) ifNil:[^self].
+ authParams at: #authResponse put: token.
+ !

Item was added:
+ ----- Method: WebClient>>token (in category 'accessing') -----
+ token
+ "The token for remote OAuth2 authentication"
+
+ ^authParams at: #token ifAbsent:[nil]!

Item was added:
+ ----- Method: WebClient>>token: (in category 'accessing') -----
+ token: aString
+ "The token for remote OAuth2 authentication"
+
+ authParams at: #token put: aString!

Item was added:
+ ----- Method: WebServer>>addToken:toRealm: (in category 'authentication') -----
+ addToken: aString toRealm: realm
+ | hash |
+ hash := WebUtils md5Digest: aString, ':', realm.
+ self passwordHashAt: (aString,':',realm) put: hash!

Item was changed:
  ----- Method: WebServer>>authAccept:request:realm:header: (in category 'authentication') -----
  authAccept: method request: request realm: realm header: authHeader
  "Performs the requested authentication method.
  Returns true if successfully authenticated.
  Subclasses can extend this method to support more auth methods."
 
  ^method asLowercase caseOf: {
  ['basic'] -> [self basicAuth: request realm: realm header: authHeader].
  ['digest'] -> [self digestAuth: request realm: realm header: authHeader].
+ ['bearer'] -> [self bearerAuth: request realm: realm header: authHeader].
  } otherwise:[false].
  !

Item was changed:
  ----- Method: WebServer>>authHeader:request:realm: (in category 'authentication') -----
  authHeader: method request: request realm: realm
  "Answer the authentication header for the given method.
  Subclasses can extend this method to support more auth methods."
 
  ^method asLowercase caseOf: {
  ['basic'] -> ['Basic realm="', realm,'"'].
  ['digest'] -> ['Digest realm="', realm,'", nonce="', self newNonce,'", qop="auth"'].
+ ['bearer'] -> ['Bearer realm="', realm,'"'].
  } otherwise:[nil].
 
  !

Item was added:
+ ----- Method: WebServer>>bearerAuth:realm:header: (in category 'authentication') -----
+ bearerAuth: request realm: realm header: authHeader
+ "Perform Bearer-based OAuth2 auth for the given request"
+
+ | data hash |
+ data := authHeader copyAfter: $ .
+ hash := WebUtils md5Digest: data, ':', realm.
+ ^(self passwordHashAt: data, ':', realm) = hash
+ !