4592267 [rkeene@sledge /home/rkeene/tmp]$ cat -n tcl-saml.tcl
   1: #! /usr/bin/tclsh
   2: 
   3: package require tax 0.2
   4: package require pki 0.6
   5: package require sha256
   6: package require sha1
   7: 
   8: namespace eval ::saml {}
   9: namespace eval ::saml::xml_c14n {}
  10: namespace eval ::saml::xml_req {}
  11: namespace eval ::saml::xml_response {}
  12: 
  13: proc ::saml::_generate_random {bytes} {
  14: 	set data ""
  15: 	while {[string length $data] < $bytes} {
  16: 		append data [::pki::_random -binary]
  17: 	}
  18: 
  19: 	set data [string range $data 0 [expr {$bytes - 1}]]
  20: 
  21: 	binary scan $data H* data
  22: 
  23: 	return $data
  24: }
  25: 
  26: proc ::saml::_sha256 {data} {
  27: 	set data [sha2::sha256 -bin $data]
  28: 	set data [binary encode base64 $data]
  29: 	return $data
  30: }
  31: 
  32: proc ::saml::_sha1 {data} {
  33: 	set data [sha1::sha1 -bin $data]
  34: 	set data [binary encode base64 $data]
  35: 	return $data
  36: }
  37: 
  38: proc ::saml::sign {key data} {
  39: 	set data [::pki::sign $data $key sha1]
  40: 	set data [binary encode base64 $data]
  41: 	return $data
  42: }
  43: 
  44: proc ::saml::verify {cert signature plaintext} {
  45: 	set data [binary decode base64 $signature]
  46: 
  47: 	set retval [::pki::verify $data $plaintext $cert]
  48: 
  49: 	return $retval
  50: }
  51: 
  52: proc ::saml::xml_c14n::cb {tag close selfclose attrslist body} {
  53: 	if {$tag == "docstart"} {
  54: 		return
  55: 	}
  56: 
  57: 	set skip 0
  58: 
  59: 	foreach skip_ele $::saml::xml_c14n::skiplist {
  60: 		if {[lsearch -exact $::saml::xml_c14n::stack $skip_ele] != -1} {
  61: 			set skip 1
  62: 		}
  63: 
  64: 		if {$tag == $skip_ele} {
  65: 			set skip 1
  66: 		}
  67: 	}
  68: 
  69: 	if {$::saml::xml_c14n::startele != ""} {
  70: 		if {[lsearch -exact $::saml::xml_c14n::stack $::saml::xml_c14n::startele] == -1 && $tag != $::saml::xml_c14n::startele} {
  71: 			set skip 1
  72: 		}
  73: 	}
  74: 
  75: 	if {$close} {
  76: 		if {!$skip} {
  77: 			append ::saml::xml_c14n::buf "</$tag>"
  78: 		}
  79: 
  80: 		set ::saml::xml_c14n::stack [lrange $::saml::xml_c14n::stack 0 end-1]
  81: 
  82: 		return
  83: 	}
  84: 
  85: 	lappend ::saml::xml_c14n::stack $tag
  86: 
  87: 	set attrstr ""
  88: 	foreach {attr val} $attrslist {
  89: 		append attrstr " $attr=\"$val\""
  90: 	}
  91: 
  92: 	if {!$skip} {
  93: 		append ::saml::xml_c14n::buf "<$tag$attrstr>[string trim $body]"
  94: 	}
  95: 
  96: 	if {$selfclose} {
  97: 		if {!$skip} {
  98: 			append ::saml::xml_c14n::buf "</$tag>"
  99: 		}
 100: 
 101: 		set ::saml::xml_c14n::stack [lrange $::saml::xml_c14n::stack 0 end-1]
 102: 	}
 103: }
 104: 
 105: proc ::saml::xml_c14n::c14n {xml {skiplist ""} {startele ""}} {
 106: 	set ::saml::xml_c14n::stack [list]
 107: 	set ::saml::xml_c14n::buf ""
 108: 	set ::saml::xml_c14n::skiplist $skiplist
 109: 	set ::saml::xml_c14n::startele $startele
 110: 
 111: 	::tax::parse ::saml::xml_c14n::cb $xml
 112: 
 113: 	return $::saml::xml_c14n::buf
 114: }
 115: 
 116: proc ::saml::xml_req::cb {tag close selfclose attrslist body} {
 117: 	if {$tag == "docstart"} {
 118: 		return
 119: 	}
 120: 
 121: 	if {$close} {
 122: 		set ::saml::xml_req::stack [lrange $::saml::xml_req::stack 0 end-1]
 123: 
 124: 		return
 125: 	}
 126: 
 127: 	regsub {^.*:} $tag {} short_tag
 128: 	lappend ::saml::xml_req::stack $short_tag
 129: 
 130: 	array set attrs $attrslist
 131: 
 132: 	set location [join $::saml::xml_req::stack .]
 133: 
 134: 	switch -- $location {
 135: 		{AuthnRequest} {
 136: parray attrs
 137: 			if {[info exists attrs(AssertionConsumerServiceURL)]} {
 138: 				set ::saml::xml_req::ret(spurl) $attrs(AssertionConsumerServiceURL)
 139: 			}
 140: 			if {[info exists attrs(Destination)]} {
 141: 				set ::saml::xml_req::ret(idpurl) $attrs(Destination)
 142: 			}
 143: 			if {[info exists attrs(ID)]} {
 144: 				set ::saml::xml_req::ret(id) $attrs(ID)
 145: 			}
 146: 		}
 147: 		{AuthnRequest.Issuer} {
 148: 			set ::saml::xml_req::ret(issuer) [string trim $body]
 149: 		}
 150: 	}
 151: 
 152: 	if {$selfclose} {
 153: 		set ::saml::xml_req::stack [lrange $::saml::xml_req::stack 0 end-1]
 154: 	}
 155: }
 156: 
 157: proc ::saml::xml_req::parse {xml} {
 158: 	set ::saml::xml_req::stack [list]
 159: 	unset -nocomplain ::saml::xml_req::ret
 160: 
 161: 	array set ::saml::xml_req::ret [list]
 162: 
 163: 	tax::parse ::saml::xml_req::cb $xml
 164: 
 165: 	foreach {var val} [array get ::saml::xml_req::ret] {
 166: 		if {[string match {*[<"'">]*} $val]} {
 167: 			continue
 168: 		}
 169: 
 170: 		if {[string match "*@|@*" $val]} {
 171: 			continue
 172: 		}
 173: 
 174: 		lappend ret $var $val
 175: 	}
 176: 
 177: 	return $ret
 178: }
 179: 
 180: proc ::saml::xml_response::cb {tag close selfclose attrslist body} {
 181: 	if {$tag == "docstart"} {
 182: 		return
 183: 	}
 184: 
 185: 	if {$close} {
 186: 		set ::saml::xml_response::stack [lrange $::saml::xml_response::stack 0 end-1]
 187: 
 188: 		return
 189: 	}
 190: 
 191: 	regsub {^.*:} $tag {} short_tag
 192: 	lappend ::saml::xml_response::stack $short_tag
 193: 
 194: 	array set attrs $attrslist
 195: 
 196: 	set location [join $::saml::xml_response::stack .]
 197: 
 198: 	switch -- $location {
 199: 		{Response.Status.StatusCode} {
 200: 			if {[info exists attrs(Value)]} {
 201: 				set ::saml::xml_response::ret(status) $attrs(Value)
 202: 			}
 203: 		}
 204: 		{Response.Assertion.Subject.NameID} {
 205: 			if {[info exists attrs(Format)]} {
 206: 				set ::saml::xml_response::ret(uid-format) $attrs(Format)
 207: 			}
 208: 			set ::saml::xml_response::ret(uid) $body
 209: 		}
 210: 		{Response.Assertion.Signature.SignedInfo.Reference.DigestMethod} {
 211: 			set ::saml::xml_response::ret(digest-method) $attrs(Algorithm)
 212: 		}
 213: 		{Response.Assertion.Signature.SignedInfo.Reference.DigestValue} {
 214: 			set ::saml::xml_response::ret(digest) $body
 215: 		}
 216: 		{Response.Assertion.Signature.SignatureValue} {
 217: 			set ::saml::xml_response::ret(signature) $body
 218: 		}
 219: 		{Response.Assertion.Signature.KeyInfo.X509Data.X509Certificate} {
 220: 			set ::saml::xml_response::ret(certificate) $body
 221: 		}
 222: 		{Response.Assertion.Conditions} {
 223: 			set ::saml::xml_response::ret(conditions) [array get attrs]
 224: 		}
 225: 	}
 226: 
 227: 	if {$selfclose} {
 228: 		set ::saml::xml_response::stack [lrange $::saml::xml_response::stack 0 end-1]
 229: 	}
 230: }
 231: 
 232: proc ::saml::xml_response::parse {xml} {
 233: 	regsub -all {^<\?.*\?>} $xml {} xml
 234: 	set ::saml::xml_response::stack [list]
 235: 	unset -nocomplain ::saml::xml_response::ret
 236: 
 237: 	array set ::saml::xml_response::ret [list]
 238: 
 239: 	tax::parse ::saml::xml_response::cb $xml
 240: 
 241: 	foreach {var val} [array get ::saml::xml_response::ret] {
 242: 		if {[string match {*[<"'">]*} $val]} {
 243: 			continue
 244: 		}
 245: 
 246: 		if {[string match "*@|@*" $val]} {
 247: 			continue
 248: 		}
 249: 
 250: 		lappend ret $var $val
 251: 	}
 252: 
 253: 	return $ret
 254: }
 255: 
 256: proc ::saml::gen_request {issuer} {
 257: 	set id [::saml::_generate_random 20]
 258: 	set now [clock format [clock seconds] -format {%Y-%m-%dT%H:%M:%S}]
 259: 
 260: 	set request "<samlp:AuthnRequest xmlns:samlp=\"urn:oasis:names:tc:SAML:2.0:protocol\" xmlns:saml=\"urn:oasis:names:tc:SAML:2.0:assertion\" ID=\"$id\" Version=\"2.0\" IssueInstant=\"$now\" AssertionConsumerServiceIndex=\"0\" AttributeConsumingServiceIndex=\"0\" AssertionConsumerServiceURL=\"$issuer\">"
 261: 	append request "\t<saml:Issuer>$issuer</saml:Issuer>"
 262: 	append request "\t<samlp:NameIDPolicy AllowCreate=\"true\" Format=\"urn:oasis:names:tc:SAML:2.0:nameid-format:persistent\"/>"
 263: 	append request "</samlp:AuthnRequest>"
 264: }
 265: 
 266: proc ::saml::verify_signature {response_arr response_xml certificate} {
 267: 	regsub -all {^<\?.*\?>} $response_xml {} response_xml
 268: 	array set response $response_arr
 269: 
 270: 	# Compute digest (XXX: TODO: Support other methods, like SHA256)
 271: 	set digest_of [::saml::xml_c14n::c14n $response_xml [list "ds:Signature"] "Assertion"]
 272: 	set digest [::saml::_sha1 $digest_of]
 273: 
 274: 	if {$digest != $response(digest)} {
 275: 		return false
 276: 	}
 277: 
 278:         # Compute signature
 279: 	set user_certificate [pki::x509::parse_cert [binary decode base64 $response(certificate)]]
 280:         set signature_of [::saml::xml_c14n::c14n $response_xml [list] "ds:SignedInfo"]
 281:         set valid_signature [::saml::verify $user_certificate $response(signature) $signature_of]
 282: 	if {!$valid_signature} {
 283: 		return false
 284: 	}
 285: 
 286: 	# Verify certificate was one used
 287: 	array set certificate_array [pki::x509::parse_cert $certificate]
 288: 	array set user_certificate_array $user_certificate
 289: 	if {$certificate_array(n) != $user_certificate_array(n)} {
 290: 		return false
 291: 	}
 292: 
 293: 	return true
 294: }
 295: 
 296: proc ::saml::response {response_xml cert} {
 297: 	array set response [::saml::xml_response::parse $response_xml]
 298: 
 299: 	set valid [::saml::verify_signature [array get response] $response_xml $cert]
 300: 	if {!$valid} {
 301: 		return [list status FAILED status_reason invalid_signature]
 302: 	}
 303: 
 304: 	array set retval [list]
 305: 
 306: 	switch -- $response(status) {
 307: 		{urn:oasis:names:tc:SAML:2.0:status:Success} {
 308: 			set retval(status) OK
 309: 		}
 310: 		default {
 311: 			return [list status FAILED status_reason response_status_invalid]
 312: 		}
 313: 	}
 314: 
 315: 	set now [clock seconds]
 316: 	foreach {condition value} $response(conditions) {
 317: 		switch -- $condition {
 318: 			NotBefore {
 319: 				set value [clock scan $value -format {%Y-%m-%dT%H:%M:%S%Z}]
 320: 				if {$now < $value} {
 321: 					return [list status FAILED status_reason condition_$condition]
 322: 				}
 323: 			}
 324: 			NotOnOrAfter {
 325: 				set value [clock scan $value -format {%Y-%m-%dT%H:%M:%S%Z}]
 326: 				if {$now >= $value} {
 327: 					return [list status FAILED status_reason condition_$condition]
 328: 				}
 329: 			}
 330: 			default {
 331: 				return [list status FAILED status_reason condition_$condition]
 332: 			}
 333: 		}
 334: 	}
 335: 
 336: 	if {[info exists response(uid)]} {
 337: 		set retval(uid) $response(uid)
 338: 	}
 339: 
 340: 	return [array get retval]
 341: }
 342: 
 343: proc ::saml::request {key cert id data username {spurl ""}} {
 344: 	if {$data != ""} {
 345: 		array set reqinfo [::saml::xml_req::parse $data]
 346: 	} else {
 347: 		set reqinfo(spurl) $spurl
 348: 	}
 349: 
 350: 	set key [::pki::pkcs::parse_key $key]
 351: 
 352: 	set response {<samlp:Response
 353:     xmlns:samlp="urn:oasis:names:tc:SAML:2.0:protocol"
 354:     xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
 355:     Consent="urn:oasis:names:tc:SAML:2.0:consent:unspecified"
 356:     Destination="@|@DESTINATION@|@"
 357:     ID="_@|@RESID@|@"
 358:     InResponseTo="@|@REQID@|@"
 359:     IssueInstant="@|@CURRENTTIME@|@"
 360:     Version="2.0"
 361:     xsi:schemaLocation="urn:oasis:names:tc:SAML:2.0:protocol http://docs.oasis-open.org/security/saml/v2.0/saml-schema-protocol-2.0.xsd">
 362: 	<saml:Issuer xmlns:saml="urn:oasis:names:tc:SAML:2.0:assertion">
 363: 		@|@ISSUERID@|@
 364: 	</saml:Issuer>
 365: 	<samlp:Status>
 366: 		<samlp:StatusCode
 367: 		    Value="urn:oasis:names:tc:SAML:2.0:status:Success">
 368: 		</samlp:StatusCode>
 369: 	</samlp:Status>
 370: 	<Assertion
 371: 	    xmlns="urn:oasis:names:tc:SAML:2.0:assertion"
 372: 	    ID="_@|@ASSERTID@|@"
 373: 	    IssueInstant="@|@CURRENTTIME@|@"
 374: 	    Version="2.0">
 375: 		<Issuer>
 376: 			@|@ISSUERID@|@
 377: 		</Issuer>
 378: 		<ds:Signature
 379: 		    xmlns:ds="http://www.w3.org/2000/09/xmldsig#">
 380: 			<ds:SignedInfo xmlns:ds="http://www.w3.org/2000/09/xmldsig#">
 381: 				<ds:CanonicalizationMethod
 382: 				    Algorithm="http://www.w3.org/2001/10/xml-exc-c14n#"/>
 383: 				<ds:SignatureMethod
 384: 				    Algorithm="http://www.w3.org/2000/09/xmldsig#rsa-sha1"/>
 385: 				<ds:Reference
 386: 				    URI="#_@|@ASSERTID@|@">
 387: 					<ds:Transforms>
 388: 						<ds:Transform
 389: 						    Algorithm="http://www.w3.org/2000/09/xmldsig#enveloped-signature"/>
 390: 						<ds:Transform
 391: 						    Algorithm="http://www.w3.org/2001/10/xml-exc-c14n#"/>
 392: 					</ds:Transforms>
 393: 					<ds:DigestMethod
 394: 					    Algorithm="http://www.w3.org/2000/09/xmldsig#sha1"/>
 395: 					<ds:DigestValue>@|@DIGEST@|@</ds:DigestValue>
 396: 				</ds:Reference>
 397: 			</ds:SignedInfo>
 398: 			<ds:SignatureValue>@|@SIGNATURE@|@</ds:SignatureValue>
 399: 			<KeyInfo
 400: 			    xmlns="http://www.w3.org/2000/09/xmldsig#">
 401: 				<ds:X509Data>
 402: 					<ds:X509Certificate>@|@CERTIFICATE@|@</ds:X509Certificate>
 403: 				</ds:X509Data>
 404: 			</KeyInfo>
 405: 		</ds:Signature>
 406: 		<Subject>
 407: 			<NameID Format="urn:oasis:names:tc:SAML:2.0:nameid-format:persistent">
 408: 				@|@USERNAME@|@
 409: 			</NameID>
 410: 			<SubjectConfirmation
 411: 			    Method="urn:oasis:names:tc:SAML:2.0:cm:bearer">
 412: 				<SubjectConfirmationData
 413: 				    InResponseTo="@|@REQID@|@"
 414: 				    NotOnOrAfter="@|@EXPIRETIME@|@"
 415: 				    Recipient="@|@DESTINATION@|@"/>
 416: 			</SubjectConfirmation>
 417: 		</Subject>
 418: 		<Conditions NotBefore="@|@CURRENTTIME@|@" NotOnOrAfter="@|@EXPIRETIME@|@">
 419: 			<AudienceRestriction>
 420: 				<Audience>
 421: 					@|@REQISSUERID@|@
 422: 				</Audience>
 423: 			</AudienceRestriction>
 424: 		</Conditions>
 425: 		<AttributeStatement>
 426: 			<Attribute
 427: 			    Name="uid">
 428: 				<AttributeValue>@|@USERNAME@|@</AttributeValue>
 429: 			</Attribute>
 430: 		</AttributeStatement>
 431: 		<AuthnStatement
 432: 		    AuthnInstant="@|@CURRENTTIME@|@"
 433: 		    SessionIndex="_@|@ASSERTID@|@">
 434: 			<AuthnContext>
 435: 				<AuthnContextClassRef>
 436: 					urn:oasis:names:tc:SAML:2.0:ac:classes:PasswordProtectedTransport
 437: 				</AuthnContextClassRef>
 438: 			</AuthnContext>
 439: 		</AuthnStatement>
 440: 	</Assertion>
 441: </samlp:Response>}
 442: 
 443: 	# Compute Parameters
 444: 	## Certificate
 445: 	array set certarray [::pki::_parse_pem $cert "-----BEGIN CERTIFICATE-----" "-----END CERTIFICATE-----"]
 446: 	set cert [binary encode base64 $certarray(data)]
 447: 	set response_map(@|@CERTIFICATE@|@) $cert
 448: 
 449: 	## Permenant Identifiers
 450: 	### Destination URL (Service Provider, from request)
 451: 	if {[info exists reqinfo(spurl)]} {
 452: 		set response_map(@|@DESTINATION@|@) $reqinfo(spurl)
 453: 	}
 454: 
 455: 	### Destination ID (from request)
 456: 	if {[info exists reqinfo(issuer)]} {
 457: 		set response_map(@|@REQISSUERID@|@) $reqinfo(issuer)
 458: 	}
 459: 
 460: 	### Issuer (Identity Provider)
 461: 	set response_map(@|@ISSUERID@|@) $id
 462: 
 463: 	## Temporary Identifiers
 464: 	### Session Identifier (from request)
 465: 	if {[info exists reqinfo(id)]} {
 466: 		set response_map(@|@REQID@|@) $reqinfo(id)
 467: 	}
 468: 
 469: 	### Response Identifier
 470: 	set response_map(@|@RESID@|@) [::saml::_generate_random 20]
 471: 
 472: 	### Assertion Identifier
 473: 	set response_map(@|@ASSERTID@|@) [::saml::_generate_random 20]
 474: 
 475: 	## Times
 476: 	### Current time
 477: 	set response_map(@|@CURRENTTIME@|@) [clock format [clock seconds] -format {%Y-%m-%dT%H:%M:%SZ} -timezone :UTC]
 478: 
 479: 	### Expiration of token (30 minutes)
 480: 	set response_map(@|@EXPIRETIME@|@) [clock format [clock add [clock seconds] 30 minutes] -format {%Y-%m-%dT%H:%M:%SZ} -timezone :UTC]
 481: 
 482: 	## Username
 483: 	set response_map(@|@USERNAME@|@) $username
 484: 
 485: 	# Insert Parameters
 486: 	set response [string map [array get response_map] $response]
 487: 
 488: 	# Remove lines that contain unsubstituted values
 489: 	set new_response [list]
 490: 	foreach line [split $response "\n"] {
 491: 		if {[string match "*@|@*" $line]} {
 492: 			if {![string match "*@|@DIGEST@|@*" $line] && ![string match "*@|@SIGNATURE@|@*" $line]} {
 493: 				continue
 494: 			}
 495: 		}
 496: 
 497: 		lappend new_response $line
 498: 	}
 499: 	set response [join $new_response "\n"]
 500: 
 501: 	# Compute digest
 502: 	set digest_of [::saml::xml_c14n::c14n $response [list "ds:Signature"] "Assertion"] 
 503: 	set response_digest [::saml::_sha1 $digest_of]
 504: 	set response [string map [list @|@DIGEST@|@ $response_digest] $response]
 505: 
 506: 	# Compute signature
 507: 	set signature_of [::saml::xml_c14n::c14n $response [list] "ds:SignedInfo"]
 508: 	set response_signature [::saml::sign $key $signature_of]
 509: 	set response [string map [list @|@SIGNATURE@|@ $response_signature] $response]
 510: 
 511: 	# Emit response
 512: 	return [list spurl $reqinfo(spurl) response [encoding convertto utf-8 "<?xml version=\"1.0\" encoding=\"utf-8\"?>[::saml::xml_c14n::c14n $response]"]]
 513: }
 514: 
 515: proc ::saml::idp_metadata {cert providerid location} {
 516: 	set response {<md:EntityDescriptor xmlns:md="urn:oasis:names:tc:SAML:2.0:metadata" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" ID="@@ID@@" cacheDuration="PT1440M" entityID="@@PROVIDERID@@" xsi:schemaLocation="urn:oasis:names:tc:SAML:2.0:metadata http://docs.oasis-open.org/security/saml/v2.0/saml-schema-metadata-2.0.xsd">
 517: 	<md:IDPSSODescriptor protocolSupportEnumeration="urn:oasis:names:tc:SAML:2.0:protocol">
 518: 		<md:KeyDescriptor use="signing">
 519: 			<ds:KeyInfo xmlns:ds="http://www.w3.org/2000/09/xmldsig#">
 520: 				<ds:X509Data>
 521: 					<ds:X509Certificate>@@CERTIFICATE@@</ds:X509Certificate>
 522: 				</ds:X509Data>
 523: 			</ds:KeyInfo>
 524: 		</md:KeyDescriptor>
 525: 		<md:NameIDFormat>urn:oasis:names:tc:SAML:2.0:nameid-format:persistent</md:NameIDFormat>
 526: 		<md:SingleSignOnService Binding="urn:oasis:names:tc:SAML:2.0:bindings:HTTP-Redirect" Location="@@LOCATION@@"/>
 527: 	</md:IDPSSODescriptor>
 528: </md:EntityDescriptor>}
 529: 
 530: 	# Compute Parameters
 531: 	## Certificate
 532: 	array set certarray [::pki::_parse_pem $cert "-----BEGIN CERTIFICATE-----" "-----END CERTIFICATE-----"]
 533: 	set cert [binary encode base64 $certarray(data)]
 534: 	set response_map(@@CERTIFICATE@@) $cert
 535: 
 536: 	## Identity Provider ID
 537: 	set response_map(@@PROVIDERID@@) $providerid
 538: 
 539: 	## Location
 540: 	set response_map(@@LOCATION@@) $location
 541: 
 542: 	## ID
 543: 	set id [sha2::sha256 -hex "$providerid"]
 544: 	set response_map(@@ID@@) $id
 545: 
 546: 	## Insert parameters
 547: 	set response [string map [array get response_map] $response]
 548: 
 549: 	return $response
 550: }
 551: 
 552: package provide saml 0.1
4592268 [rkeene@sledge /home/rkeene/tmp]$

Click here to go back to the directory listing.
Click here to download this file.
last modified: 2016-02-01 18:42:31