~amsn-daily/amsn/amsn-packaging : contents of auth.tcl at revision 9898

~amsn-daily/amsn/amsn-packaging : (revision 9898)

::Version::setSubversionId {$Id$}

package require des

snit::type SecurityToken {
	option -name -default ""
	option -address -default ""
	option -policy -default ""
	option -type -default ""
	option -created -default ""
	option -expires -default ""
	option -ticket -default ""
	option -proof -default ""
	option -local_clock -default ""
	option -server_clock -default ""

	method IsExpired { } {
		if {$options(-ticket) == "" ||
		    $options(-local_clock) == "" ||
		    $options(-server_clock) == "" ||
		    $options(-expires) == ""} {
			return 1
		}
		set created_clock $options(-local_clock)
		set current_clock [clock seconds]
		set elapsed [expr {$current_clock - $created_clock}]
		
		set created 0
		set expires 0
		if { [regexp {(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2})} $options(-server_clock) -> y m d h min s] } {
			set created [clock scan "${y}-${m}-${d} ${h}:${min}:${s}"]
		}
		if { [regexp {(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2})} $options(-expires) -> y m d h min s] } {
			set expires [clock scan "${y}-${m}-${d} ${h}:${min}:${s}"]
		}
		if {$created == 0 || $expires == 0 } {
			return 1
		}
		set remaining [expr {$expires - $created}]
		if {$remaining < $elapsed} {
			return 1
		} else {
			return 0
		}
	}
}


# Single Sign-On Authentication method (used by MSNP15+)
snit::type SSOAuthentication {
	variable security_tokens
	variable soap_req ""
	variable callbacks [list]
	option -username -default ""
	option -password -default ""
	option -nonce -default ""
	option -done -default 0

	constructor { args } {
		$self configurelist $args

		set security_tokens [SecurityToken create %AUTO% -name Passport -address "http://Passport.NET/tb"]

		lappend security_tokens [SecurityToken create %AUTO% -name Contacts -address "contacts.msn.com" -policy "MBI"]
		lappend security_tokens [SecurityToken create %AUTO% -name Messenger -address "messenger.msn.com" -policy "?id=507"]
		lappend security_tokens [SecurityToken create %AUTO% -name MessengerClear -address "messengerclear.live.com" -policy "MBI_KEY_OLD"]
		lappend security_tokens [SecurityToken create %AUTO% -name MessengerSecure -address "messengersecure.live.com" -policy "MBI_SSL"]
		
		lappend security_tokens [SecurityToken create %AUTO% -name Spaces -address "spaces.live.com" -policy "MBI"]
		lappend security_tokens [SecurityToken create %AUTO% -name Storage -address "storage.msn.com" -policy "MBI"]

	}

	destructor {
		catch {
			foreach token $security_tokens {
				$token destroy
			}
			set security_tokens ""
		}
		if { $soap_req != "" } {
			catch { $soap_req destroy }
			set soap_req ""
		}
		
	}

	method RequireSecurityToken { name command {full 0} } {
		set token [$self GetSecurityTokenByName $name]
		if {$token == "" || [$token IsExpired] } {
			lappend callbacks [list $name $command $full]
			$self Authenticate [list $self RequireSecurityTokenCB ]
		} else {
			if {$full} {
				eval $command [list $token]
			} else {
				eval $command [list [$token cget -ticket]]
			}
		}
	}

	method RequireSecurityTokenCB {err} {
		set clbks $callbacks 
		set callbacks [list]
		
		foreach callback $clbks {
			foreach {name command full} $callback break
			set token [$self GetSecurityTokenByName $name]
			if {$full} {
				eval $command [list $token]
			} else {
				eval $command [list [$token cget -ticket]]
			}
		}
	}

	method GetSecurityTokenByName { name } {
		foreach token $security_tokens {
			set n [$token cget -name]
			if {$n == $name } {
				return $token
			}
		}
		return ""
	}
	method GetSecurityTokenByAddress { address } {
		foreach token $security_tokens {
			set addr [$token cget -address]
			if {$addr == $address } {
				return $token
			}
		}
		return ""
	}
	
	method AuthenticateCallback { callbk soap } {
		status_log "SSO::AuthenticateCallback : $soap - [$soap GetStatus]"
		if { [$soap GetStatus] == "success" } {
			set xml  [$soap GetResponse]
			set server_clock [GetXmlAttribute $xml "S:Envelope:S:Header:psf:pp:psf:serverInfo" "ServerTime"]
			set i 0
			while {1} {
				set subxml [GetXmlNode $xml "S:Envelope:S:Body:wst:RequestSecurityTokenResponseCollection:wst:RequestSecurityTokenResponse" $i]
				incr i
				if  { $subxml == "" } {
					break
				}
			
				set address [GetXmlEntry $subxml "wst:RequestSecurityTokenResponse:wsp:AppliesTo:wsa:EndpointReference:wsa:Address"]
				set token [$self GetSecurityTokenByAddress $address]
				#puts "$subxml\n\n\n"
				if {$token != "" } {
					$token configure -type [GetXmlEntry $subxml "wst:RequestSecurityTokenResponse:wst:TokenType"]
					$token configure -created [GetXmlEntry $subxml "wst:RequestSecurityTokenResponse:wst:LifeTime:wsu:Created"]
					$token configure -expires [GetXmlEntry $subxml "wst:RequestSecurityTokenResponse:wst:LifeTime:wsu:Expires"]
					$token configure -ticket [GetXmlEntry $subxml "wst:RequestSecurityTokenResponse:wst:RequestedSecurityToken:wsse:BinarySecurityToken"]
					if {[$token cget -ticket] == "" } {
						catch {$token configure -ticket [list2xml [GetXmlNode $subxml "wst:RequestSecurityTokenResponse:wst:RequestedSecurityToken:EncryptedData"]]}
					}
					$token configure -proof [GetXmlEntry $subxml "wst:RequestSecurityTokenResponse:wst:RequestedProofToken:wst:BinarySecret"]
					$token configure -local_clock [clock seconds]
					$token configure -server_clock $server_clock

					status_log "Found security token $token for address $address" green
					set faultcode [GetXmlEntry $subxml "wst:RequestSecurityTokenResponse:S:Fault:faultcode"]
					set faultstring [GetXmlEntry $subxml "wst:RequestSecurityTokenResponse:S:Fault:faultstring"]
					if {$faultcode == "wsse:FailedAuthentication"} {
						if {[string trim $faultstring] == "Profile accrual is required"} {
							set error 4
						} else {
							set error 5
						}
						status_log "Security token for $address had a fault ($faultcode): $faultstring" red
						if {[catch {eval $callbk [list $error]} result]} {
							bgerror $result
						}
						return
					}
				}
			}
			if {[catch {eval $callbk [list 0]} result]} {
				bgerror $result
			}
		} elseif  {[$soap GetStatus] == "fault" } {
			set faultcode [$soap GetFaultCode]
			set faultstring [$soap GetFaultString]
			
			status_log "Error authenticating : $faultcode - $faultstring" green
			if {$faultcode == "wsse:FailedAuthentication" } {
				set error 2
			} elseif {$faultcode == "psf:Redirect"} {
				set xml  [$soap GetResponse]
				set url [GetXmlEntry $xml "S:Envelope:S:Fault:psf:redirectUrl"]
				status_log "SSO Authentication redirected to $url"
				$soap configure -url $url
				if {[catch {$soap SendSOAPRequest} ] } {
					set error 3
				} else {
					return
				}
			} else {
				set error 1
			}
			if {[catch {eval $callbk [list $error]} result]} {
				bgerror $result
			}
		} else {
			$soap destroy
			set soap_req ""
			if {[catch {eval $callbk [list 1]} result]} {
				bgerror $result
			}
		}
	}
	
	method Authenticate { callbk } {
		if {$soap_req != "" } {
			$soap_req destroy
			set soap_req ""
		}
		set soap_req [SOAPRequest create %AUTO% \
				  -url "https://login.live.com/RST.srf" \
				  -xml [$self getSSOXml] \
				  -callback [list $self AuthenticateCallback $callbk]]
		$soap_req SendSOAPRequest
	}
	
	method getSSOXml { args } {

		set xml {<Envelope xmlns="http://schemas.xmlsoap.org/soap/envelope/" xmlns:wsse="http://schemas.xmlsoap.org/ws/2003/06/secext" xmlns:saml="urn:oasis:names:tc:SAML:1.0:assertion" xmlns:wsp="http://schemas.xmlsoap.org/ws/2002/12/policy" xmlns:wsu="http://docs.oasis-open.org/wss/2004/01/oasis-200401-wss-wssecurity-utility-1.0.xsd" xmlns:wsa="http://schemas.xmlsoap.org/ws/2004/03/addressing" xmlns:wssc="http://schemas.xmlsoap.org/ws/2004/04/sc" xmlns:wst="http://schemas.xmlsoap.org/ws/2004/04/trust">}

		append xml {<Header>}
		append xml {<ps:AuthInfo xmlns:ps="http://schemas.microsoft.com/Passport/SoapServices/PPCRL" Id="PPAuthInfo">}
		append xml {<ps:HostingApp>{7108E71A-9926-4FCB-BCC9-9A9D3F32E423}</ps:HostingApp>}
		append xml {<ps:BinaryVersion>4</ps:BinaryVersion>}
		append xml {<ps:UIVersion>1</ps:UIVersion>}
		append xml {<ps:Cookies></ps:Cookies>}
		append xml {<ps:RequestParams>AQAAAAIAAABsYwQAAAA0MTA1</ps:RequestParams>}
		append xml {</ps:AuthInfo>}

		append xml {<wsse:Security xmlns:wsse="http://schemas.xmlsoap.org/ws/2003/06/secext">}
		append xml {<wsse:UsernameToken Id="user">}
		append xml "<wsse:Username>[xmlencode $options(-username)]</wsse:Username>"
		append xml "<wsse:Password>[xmlencode $options(-password)]</wsse:Password>"
		append xml {</wsse:UsernameToken>}
		append xml {</wsse:Security>}
		append xml {</Header>}
		
		append xml {<Body>}
		append xml {<ps:RequestMultipleSecurityTokens xmlns:ps="http://schemas.microsoft.com/Passport/SoapServices/PPCRL" Id="RSTS">}

		set id 0
		foreach token $security_tokens {
			set address [$token cget -address]
			set policy [$token cget -policy]

			append xml "<wst:RequestSecurityToken Id=\"RST${id}\">"
			append xml {<wst:RequestType>http://schemas.xmlsoap.org/ws/2004/04/security/trust/Issue</wst:RequestType>}
			append xml {<wsp:AppliesTo>}
			append xml {<wsa:EndpointReference xmlns:wsa="http://schemas.xmlsoap.org/ws/2004/03/addressing">}
			append xml "<wsa:Address>${address}</wsa:Address>"
			append xml {</wsa:EndpointReference>}
			append xml {</wsp:AppliesTo>}

			# The http://Passport.NET/tb token doesn't have a policy reference
			if {$policy != ""} {
				append xml "<wsse:PolicyReference xmlns:wsse=\"http://schemas.xmlsoap.org/ws/2003/06/secext\" URI=\"[xmlencode ${policy}]\">"
				append xml {</wsse:PolicyReference>}
			}
			append xml {</wst:RequestSecurityToken>}
			
			incr id
		}

		append xml {</ps:RequestMultipleSecurityTokens>}
		append xml {</Body>}
		append xml {</Envelope>}

		return $xml
	}
}


snit::type MBIAuthentication {

	typemethod MBICrypt {nonce proof } {
		set key1 [base64::decode $proof]
		set key2 [MBIAuthentication deriveKey $key1 "WS-SecureConversationSESSION KEY HASH"]
		set key3 [MBIAuthentication deriveKey $key1 "WS-SecureConversationSESSION KEY ENCRYPTION"]

		set hash [binary format H* [::sha1::hmac $key2 $nonce]]

		set iv [MBIAuthentication rand 8]
		set des_message $nonce
		append des_message [string repeat "\x08" [expr {72 - [string length $nonce]}]]
		set cipher [::DES::des -mode cbc -dir encrypt -key $key3 -iv $iv -- $des_message]


		set header [binary format iiH8H8iii 28 1 03660000 04800000 [string length $iv] [string length $hash] [string length $cipher]]
		set data "${iv}${hash}${cipher}"

		return [string map {"\n" ""} [base64::encode "${header}${data}"]]
	}

	typemethod deriveKey { key magic } {
		set hash1 [binary format H* [::sha1::hmac $key $magic]]
		set hash2 [binary format H* [::sha1::hmac $key "${hash1}${magic}"]]

		set hash3 [binary format H* [::sha1::hmac $key $hash1]]
		set hash4 [binary format H* [::sha1::hmac $key "${hash3}${magic}"]]
		return "${hash2}[string range $hash4 0 3]"
	}

	typemethod rand { bytes } {
		set result ""
		for {set i 0 } { $i < $bytes } { incr i } {
			append result [binary format c [expr {int(rand() * 256)}]]
		}
		return $result
	}
}

snit::type LockKeyAuthentication {
	

	method CreateLockKey {chldata prodid prodkey} {
        
                # Create an MD5 hash out of the given data, then form 32 bit integers from it
                set md5hash [::md5::md5 $chldata$prodkey]
                set md5parts [$self MD5HashToInt $md5hash]
        

                # Then create a valid productid string, divisable by 8, then form 32 bit integers from it
                set nrPadZeros [expr {8 - [string length $chldata$prodid] % 8}]
                set padZeros [string repeat 0 $nrPadZeros]
                set chlprodid [$self CHLProdToInt $chldata$prodid$padZeros]

                # Create the key we need to XOR
                set key [$self KeyFromInt $md5parts $chlprodid]

                set low 0x[string range $md5hash 0 15]
                set high 0x[string range $md5hash 16 32]
                set low [expr {$low ^ $key}]
                set high [expr {$high ^ $key}]

                set p1 [format %8.8x [expr {($low / 0x100000000) % 0x100000000}]]
                set p2 [format %8.8x [expr {$low % 0x100000000}]]
                set p3 [format %8.8x [expr {($high / 0x100000000) % 0x100000000}]]
                set p4 [format %8.8x [expr {$high % 0x100000000}]]

                return $p1$p2$p3$p4
        }

        method KeyFromInt { md5parts chlprod } {
                # Create a new series of numbers
                set key_temp 0
                set key_high 0
                set key_low 0
        
                # Then loop on the entries in the second array we got in the parameters
                for {set i 0} {$i < [llength $chlprod]} {incr i 2} {

                        # Make $key_temp zero again and perform calculation as described in the documents
                        set key_temp [lindex $chlprod $i]
                        set key_temp [expr {(wide(0x0E79A9C1) * wide($key_temp)) % wide(0x7FFFFFFF)}]
                        set key_temp [expr {wide($key_temp) + wide($key_high)}]
                        set key_temp [expr {(wide([lindex $md5parts 0]) * wide($key_temp)) + wide([lindex $md5parts 1])}]
                        set key_temp [expr {wide($key_temp) % wide(0x7FFFFFFF)}]

                        set key_high [lindex $chlprod [expr {$i+1}]]
                        set key_high [expr {(wide($key_high) + wide($key_temp)) % wide(0x7FFFFFFF)}]
                        set key_high [expr {(wide([lindex $md5parts 2]) * wide($key_high)) + wide([lindex $md5parts 3])}]
                        set key_high [expr {wide($key_high) % wide(0x7FFFFFFF)}]

                        set key_low [expr {wide($key_low) + wide($key_temp) + wide($key_high)}]
                }

                set key_high [expr {(wide($key_high) + wide([lindex $md5parts 1])) % wide(0x7FFFFFFF)}]
                set key_low [expr {(wide($key_low) + wide([lindex $md5parts 3])) % wide(0x7FFFFFFF)}]

                set key_high 0x[$self byteInvert [format %8.8X $key_high]]
                set key_low 0x[$self byteInvert [format %8.8X $key_low]]

                set long_key [expr {(wide($key_high) << 32) + wide($key_low)}]

                return $long_key
        }

        # Takes an CHLData + ProdID + Padded string and chops it in 4 bytes. Then converts to 32 bit integers 
        method CHLProdToInt { CHLProd } {
                set hexs {}
                set result {}
                while {[string length $CHLProd] > 0} {
                        lappend hexs [string range $CHLProd 0 3]
                        set CHLProd [string range $CHLProd 4 end]
                }
                for {set i 0} {$i < [llength $hexs]} {incr i} {
                        binary scan [lindex $hexs $i] H8 int
                        lappend result 0x[$self byteInvert $int]
                }
                return $result
        }
                

        # Takes an MD5 string and chops it in 4. Then "decodes" the HEX and converts to 32 bit integers. After that it ANDs
        method MD5HashToInt { md5hash } {
                binary scan $md5hash a8a8a8a8 hash1 hash2 hash3 hash4
                set hash1 [expr {"0x[$self byteInvert $hash1]" & 0x7FFFFFFF}]
                set hash2 [expr {"0x[$self byteInvert $hash2]" & 0x7FFFFFFF}]
                set hash3 [expr {"0x[$self byteInvert $hash3]" & 0x7FFFFFFF}]
                set hash4 [expr {"0x[$self byteInvert $hash4]" & 0x7FFFFFFF}]
                
                return [list $hash1 $hash2 $hash3 $hash4]
        }

        method byteInvert { hex } {
                set hexs {}
                while {[string length $hex] > 0} {
                        lappend hexs [string range $hex 0 1]
                        set hex [string range $hex 2 end]
                }
                set hex ""
                for {set i [expr [llength $hexs] -1]} {$i >= 0} {incr i -1} {
                        append hex [lindex $hexs $i]
                }
                return $hex
        }

}



8331 by kakaroto Add SVN $Id$ tag to the new files and add the keywords property on them...	1	::Version::setSubversionId {$Id$}
	2
	3	package require des
8795 by kakaroto Use the newest and great DES package... to avoid issues with 'invalid keyset handle' when that des package gets loaded into amsn by some plugin or something	4
	5	snit::type SecurityToken {
7866 by kakaroto Initial implementation of the SSO authentication algorithm. Not working for now, but I have to go, will fix once I get home	6	option -name -default ""
	7	option -address -default ""
	8	option -policy -default ""
	9	option -type -default ""
	10	option -created -default ""
	11	option -expires -default ""
	12	option -ticket -default ""
7869 by kakaroto MSNP15 support!!! (partial + experimental). SSO authentication works, MBI cryptography works, we can authenticate and chat and read/send OIMs, etc... BUT we just don't download the contact list yet.. will be added soon! :)	13	option -proof -default ""
7867 by kakaroto Fixes the issues i had before.. now SSO authentication works 100%svn diff yeay! :)	14	option -local_clock -default ""
8261 by kakaroto Token expiration is now fixed... if we try to use an SSO token after it expired it will automatically fetch a new one and call your function when the token is renewed..	15	option -server_clock -default ""
	16
	17	method IsExpired { } {
	18	if {$options(-ticket) == "" \|\|
	19	$options(-local_clock) == "" \|\|
	20	$options(-server_clock) == "" \|\|
	21	$options(-expires) == ""} {
	22	return 1
	23	}
	24	set created_clock $options(-local_clock)
	25	set current_clock [clock seconds]
	26	set elapsed [expr {$current_clock - $created_clock}]
	27
	28	set created 0
	29	set expires 0
	30	if { [regexp {(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2})} $options(-server_clock) -> y m d h min s] } {
	31	set created [clock scan "${y}-${m}-${d} ${h}:${min}:${s}"]
	32	}
	33	if { [regexp {(\d{4})-(\d{2})-(\d{2})T(\d{2}):(\d{2}):(\d{2})} $options(-expires) -> y m d h min s] } {
	34	set expires [clock scan "${y}-${m}-${d} ${h}:${min}:${s}"]
	35	}
	36	if {$created == 0 \|\| $expires == 0 } {
	37	return 1
	38	}
	39	set remaining [expr {$expires - $created}]
	40	if {$remaining < $elapsed} {