diff options
Diffstat (limited to 'tcllib/modules/sasl/scram.tcl')
| -rw-r--r-- | tcllib/modules/sasl/scram.tcl | 503 |
1 files changed, 503 insertions, 0 deletions
diff --git a/tcllib/modules/sasl/scram.tcl b/tcllib/modules/sasl/scram.tcl new file mode 100644 index 0000000..7f13d53 --- /dev/null +++ b/tcllib/modules/sasl/scram.tcl @@ -0,0 +1,503 @@ +# scram.tcl - Copyright (c) 2013 Sergei Golovan <sgolovan@nes.ru> +# +# This is an implementation of SCRAM-* SASL authentication +# mechanism (RFC-5802). +# +# ------------------------------------------------------------------------- +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# ------------------------------------------------------------------------- + +package require Tcl 8.2 +package require SASL +package require sha1 +package require base64 + +namespace eval ::SASL::SCRAM {} + +# ::SASL::SCRAM::Map -- +# +# Map comma and equal sign to their codes in authzid and username +# (section 5.1, a and n attributes) +# +# Arguments: +# string string subject to mapping +# +# Result: +# The given string with , replaced by =2C and = replaced by =3D +# +# Side effects: +# None +# +# Comment: +# Since comma, equal sign, 2, C, 3, D are all in ASCII, +# [encoding convertto utf-8 [Map]] gives the same result as +# [Map [encoding convertto utf-8]], so the latter is used here +# despite the former is correct formally + +proc ::SASL::SCRAM::Map {string} { + string map {, =2C = =3D} $string +} + +# ::SASL::SCRAM::Unmap -- +# +# Replace codes =2C by , and =3D by = in authzid and username +# (section 5.1, a and n attributes) +# +# Arguments: +# string authzid or username extracted from a challenge +# +# Result: +# Mapped argument +# +# Side effects: +# None +# +# Comment: +# Since comma, equal sign, 2, C, 3, D are all in ASCII, +# [encoding convertfrom utf-8 [Unmap]] gives the same result as +# [Unmap [encoding convertfrom utf-8]], and the former is used here +# despite the latter is correct formally + +proc ::SASL::SCRAM::Unmap {string} { + string map {=2C , =3D =} $string +} + +# ::SASL::SCRAM::GS2Header -- +# +# Return GS2 header for SCRAM (section 7, gs2-header) +# +# Arguments: +# authzid authorization identity (empty if it's the same as username +# to authenticate) +# +# Result: +# GS2 header for inclusion into a client messages +# +# Side effects: +# None + +proc ::SASL::SCRAM::GS2Header {authzid} { + # n means that client doesn't support channel binding + if {[string equal $authzid ""]} { + return "n,," + } else { + return "n,a=[Map $authzid]," + } +} + +# ::SASL::SCRAM::ClientFirstMessageBare -- +# +# Return the first client message without the GS2 header (section 7, +# client-first-message-bare, without extensions) +# +# Arguments: +# username Username to authenticate +# nonce Random string of printable chars +# +# Result: +# SCRAM client first message without GS2 header +# +# Side effects: +# None + +proc ::SASL::SCRAM::ClientFirstMessageBare {username nonce} { + return "n=[Map $username],r=$nonce" +} + +# ::SASL::SCRAM::ClientFirstMessage -- +# +# Return the first client message to be sent to a server (section 7, +# client-first-message, without extensions) +# +# Arguments: +# authzid authorization identity (empty if it's the same as username +# to authenticate) +# username Username to authenticate +# nonce Random string of printable chars +# +# Result: +# SCRAM client first message without GS2 header +# +# Side effects: +# None + +proc ::SASL::SCRAM::ClientFirstMessage {authzid username nonce} { + return "[GS2Header $authzid][ClientFirstMessageBare $username $nonce]" +} + +# ::SASL::SCRAM::ClientFinalMessageWithoutProof -- +# +# Return the final client message not including the client proof +# (section 7, client-final-message-without-proof, without extensions). +# Note that we don't support channel binding, so the GS2 header used +# here is the same as in the first message. This message is used twice: +# 1) as part of auth-message which hash authenticates user, 2) as part +# of the final message client sends to the server +# +# Arguments: +# authzid authorization identity (empty if it's the same as username +# to authenticate), must be the same as in the first message +# nonce Random string of printable chars, must be the one received +# from the server on step 1 +# +# Result: +# The final client message without proof +# +# Side effects: +# None + +proc ::SASL::SCRAM::ClientFinalMessageWithoutProof {authzid nonce} { + # We still don't support channel binding, so just use [GS2Header] + return "c=[base64::encode [GS2Header $authzid]],r=$nonce" +} + +# ::SASL::SCRAM::ServerFirstMessage -- +# +# Return the server first message (section 7, server-first-message) +# +# Arguments: +# nonce Random string of printable chars, it must start with the +# random string received from the client at step 0 +# salt Random binary string +# iter Number of iterations for salting password (required to be +# not less then 4096) +# +# Result: +# The first server message +# +# Side effects: +# None + +proc ::SASL::SCRAM::ServerFirstMessage {nonce salt iter} { + return "r=$nonce,s=[base64::encode $salt],i=$iter" +} + +# ::SASL::SCRAM::ParseChallenge -- +# +# Parse client or server output string and return a list of attr-value, +# suitable for [array set]. Channel binding part of GS2 header returns +# as "cbind n", "cbind y" or "cbind p p <value>", other attributes +# return simply as "<attr> <value>" +# +# Arguments: +# challenge Input string to parse +# +# Result: +# List with even number of members +# +# Side effects: +# None + +proc ::SASL::SCRAM::ParseChallenge {challenge} { + set attrval [split $challenge ,] + set params {} + set n 0 + foreach av $attrval { + incr n + if {$av == ""} continue + + if {[regexp {^([a-z])(?:=(.+))?$} $av -> attr val]} { + if {$n == 1 && ($attr == "n" || $attr == "y")} { + # Header (channel binding) + lappend params cbind $attr + } elseif {$n == 1 && $attr == "p"} { + # Header (channel binding) + lappend params cbind $attr $attr $val + } else { + lappend params $attr $val + } + } else { + return -code error "invalid challenge" + } + } + return $params +} + +# ::SASL::SCRAM::Xor -- +# +# Return bitwize XOR between two strings of equal length +# +# Arguments: +# str1 String to XOR +# str2 String to XOR +# +# Result: +# Bitwise XOR of the supplied strings or error if their lengths differ +# +# Side effects: +# None + +proc ::SASL::SCRAM::Xor {str1 str2} { + set result "" + foreach s1 [split $str1 ""] s2 [split $str2 ""] { + append result [binary format c [expr {[scan $s1 %c] ^ [scan $s2 %c]}]] + } + return $result +} + +# ::SASL::SCRAM::Hi -- +# +# Salt the given password using algorithm from section 2.2 +# +# Arguments: +# hmac Function which calculates a Hashed Message Authentication +# digest (HMAC) described in RFC 2104 in binary form +# password Password to salt +# salt Random string used as a salt +# i Number of iterations (assumed i>=1) +# +# Result: +# Salted password +# +# Side effects: +# None + +proc ::SASL::SCRAM::Hi {hmac password salt i} { + set res [set ui [$hmac $password "$salt\x0\x0\x0\x1"]] + for {set n 1} {$n < $i} {incr n} { + set ui [$hmac $password $ui] + set res [Xor $res $ui] + } + return $res +} + +# ::SASL::SCRAM::Algo -- +# +# Return client proof and server signature according to SCRAM +# algorithm from section 3. +# +# Arguments: +# hash Function which returns a cryptographic dugest in binary form +# hmac Function which calculates a Hashed Message Authentication +# digest (HMAC) described in RFC 2104 in binary form +# password User password +# salt Random string used as a salt +# i Number of iterations for password salting (assumed i>=1) +# auth_message Message which is to be hashed to get client and server +# signatures +# +# Result: +# List of two binaries with client proof and server signature +# +# Side effects: +# None + +proc ::SASL::SCRAM::Algo {hash hmac password salt i auth_message} { + set salted_password [Hi $hmac $password $salt $i] + set client_key [$hmac $salted_password "Client Key"] + set stored_key [$hash $client_key] + set client_signature [$hmac $stored_key $auth_message] + set client_proof [Xor $client_key $client_signature] + set server_key [$hmac $salted_password "Server Key"] + set server_signature [$hmac $server_key $auth_message] + return [list $client_proof $server_signature] +} + +# ::SASL::SCRAM::client -- +# +# Perform authentication step of the client part of SCRAM SASL +# procedure. It's an auxiliary procedure called from the callback +# registered with the SASL package +# +# Arguments: +# hash Function which returns a cryptographic dugest in binary form +# hmac Function which calculates a Hashed Message Authentication +# digest (HMAC) described in RFC 2104 in binary form +# context Array name which contains authentication state (in particular +# step and response values) +# challenge Input from the server +# args Ignored rest of the arguments +# +# Result: +# 1 if authentication is to be continued, 0 if it is finished with +# success, error if it is failed for some reason. ${context}(response) +# contains data to be sent to the server +# +# Side effects: +# The authzid, username, password are obtained using SASL callback. +# Step 1 uses data from step 0, and step 2 uses data from step 1 +# (stored in the context array) +# +# Known bugs and limitations: +# 1) The authzid, username and password aren't saslprepped +# 2) There's no check for 'm' attribute (authentication must fail if it's +# present) +# 3) There's no check if the server's nonce has the client's nonce as +# a prefix + +proc ::SASL::SCRAM::client {hash hmac context challenge args} { + upvar #0 $context ctx + + switch -exact -- $ctx(step) { + 0 { + # Initial message with username and random string + + # authzid and username will be used also at step 1, so store them + set ctx(authzid) [encoding convertto utf-8 [eval $ctx(callback) [list $context login]]] + set ctx(username) [encoding convertto utf-8 [eval $ctx(callback) [list $context username]]] + set ctx(nonce) [::SASL::CreateNonce] + set ctx(response) [ClientFirstMessage $ctx(authzid) $ctx(username) $ctx(nonce)] + incr ctx(step) + return 1 + } + 1 { + # Final message with client proof calculated using the user's password + + array set params [ParseChallenge $challenge] + set password [encoding convertto utf-8 [eval $ctx(callback) [list $context password]]] + set final_message [ClientFinalMessageWithoutProof $ctx(authzid) $params(r)] + set auth_message "[ClientFirstMessageBare $ctx(username) $ctx(nonce)],$challenge,$final_message" + foreach {proof signature} [Algo $hash $hmac $password [base64::decode $params(s)] $params(i) $auth_message] break + set ctx(signature) $signature + set ctx(response) "$final_message,p=[base64::encode $proof]" + incr ctx(step) + return 1 + } + 2 { + # Check of the server's signature + + array set params [ParseChallenge $challenge] + if {[info exists params(e)]} { + return -code error $params(e) + } + if {![string equal $ctx(signature) [base64::decode $params(v)]]} { + return -code error "invalid server signature" + } + incr ctx(step) + return 0 + + } + default { + return -code error "invalid state" + } + } +} + +# ::SASL::SCRAM::server -- +# +# Perform authentication step of the server part of SCRAM SASL +# procedure. It's an auxiliary procedure called from the callback +# registered with the SASL package +# +# Arguments: +# hash Function which returns a cryptographic dugest in binary form +# hmac Function which calculates a Hashed Message Authentication +# digest (HMAC) described in RFC 2104 in binary form +# context Array name which contains authentication state (in particular +# step and response values) +# clientrsp Input from the client +# args Ignored rest of the arguments +# +# Result: +# 1 if authentication is to be continued, 0 if it is finished with +# success, error if it is failed for some reason. ${context}(response) +# contains data to be sent to the server +# +# Side effects: +# The authentication realm and password are obtained using SASL callback. +# Step 1 uses data from step 0 (stored in the context array) +# +# Known bugs and limitations: +# 1) The server part needs to know the user's password (which violates the +# idea that server cannot impersonate client) +# 2) The username and password aren't saslprepped +# 3) There's no check for 'm' attribute (authentication must fail if it's +# present) +# 4) There's no check if the encoded username contains unprotected = +# 5) The authzid support is not implemented +# 6) The channel binding option at step 1 is ignored + +proc ::SASL::SCRAM::server {hash hmac context clientrsp args} { + upvar #0 $context ctx + + switch -exact -- $ctx(step) { + 0 { + if {[string length $clientrsp] == 0} { + # Do not increase the step counter here and send an empty + # challenge because SCRAM is a client-first mechanism (section + # 5 of RFC-4422) + set ctx(response) "" + return 1 + } + + # Initial response with random string, salt and number of iterations + + array set params [ParseChallenge $clientrsp] + if {![info exists params(cbind)]} { + return -code error "invalid header" + } + if {$params(cbind) == "p"} { + return -code error "channel binding is not supported" + } + + set ctx(username) [encoding convertfrom utf-8 [Unmap $params(n)]] + set ctx(salt) [::SASL::CreateNonce] + set ctx(nonce) $params(r)[::SASL::CreateNonce] + set ctx(iter) 4096 + + # Store the bare client message for AuthMessage at step 1 + regexp {^[^,]*,[^,]*,(.*)} $clientrsp -> ctx(message) + + set ctx(response) [ServerFirstMessage $ctx(nonce) $ctx(salt) $ctx(iter)] + incr ctx(step) + return 1 + } + 1 { + # Verification of the client's proof and response with the + # server's signature + + array set params [ParseChallenge $clientrsp] + set realm [eval $ctx(callback) [list $context realm]] + set password [encoding convertto utf-8 [eval $ctx(callback) [list $context password $ctx(username) $realm]]] + + # Remove proof to create AuthMessage + regexp {(.*),p=[^,]*$} $clientrsp -> final_message + set auth_message "$ctx(message),[ServerFirstMessage $ctx(nonce) $ctx(salt) $ctx(iter)],$final_message" + foreach {proof signature} [Algo $hash $hmac $password $ctx(salt) $ctx(iter) $auth_message] break + if {![string equal $proof [base64::decode $params(p)]]} { + return -code error "authentication failed" + } + set ctx(response) "v=[base64::encode $signature]" + incr ctx(step) + return 0 + } + default { + return -code error "invalid state" + } + } +} + +# ------------------------------------------------------------------------- +# Provide the mandatory SCRAM-SHA-1 mechanism + +proc ::SASL::SCRAM::SHA-1:hash {str} { + sha1::sha1 -bin $str +} + +proc ::SASL::SCRAM::SHA-1:hmac {key str} { + sha1::hmac -bin -key $key $str +} + +proc ::SASL::SCRAM::SHA-1:client {context challenge args} { + client ::SASL::SCRAM::SHA-1:hash ::SASL::SCRAM::SHA-1:hmac $context $challenge +} + +proc ::SASL::SCRAM::SHA-1:server {context clientrsp args} { + server ::SASL::SCRAM::SHA-1:hash ::SASL::SCRAM::SHA-1:hmac $context $clientrsp +} + +# Register the SCRAM-SHA-1 SASL mechanism with the Tcllib SASL package + +::SASL::register SCRAM-SHA-1 50 ::SASL::SCRAM::SHA-1:client ::SASL::SCRAM::SHA-1:server + +# ------------------------------------------------------------------------- + +package provide SASL::SCRAM 0.1 + +# ------------------------------------------------------------------------- +# +# Local variables: +# indent-tabs-mode: nil +# End: +# vim:ts=8:sw=4:sts=4:et |