SASL and TWAPI

On the Tcl chat, JKU pastedbin'ed a TWAPI based provider for tcllib's SASL module. Copied here for safekeeping.

APN 2013-12-14 As of TWAPI 4.0b25, the code below will not work as the SSPI API has changed (my excuse is that it was marked experimental). I will try and post an edited version later.

package require SASL
package require twapi

namespace eval ::SASL::sspi {
        variable sspi_handles
        array set sspi_handles {}
}

proc ::SASL::sspi::Cleanup {ctx} {
        variable sspi_handles
        ::twapi::sspi_close_security_context $sspi_handles($ctx)
        unset sspi_handles($ctx)
}

proc ::SASL::sspi::clientproc {mech context challenge args} {
        upvar #0 $context ctx
        variable sspi_handles
        if {$ctx(count) == 1} {
                if {[info exists sspi_handles($context)]} {
                        sspi_close_security_context $sspi_handles($context)
                }
                # Try to get some values from the callback
                set cred_opts {}
                foreach {type arg} {-user username -password password -domain realm} {
                        if {![catch "$ctx(callback) [list $context $arg]" res] && $res ne ""} {
                                dict set cred_opts $type $res
                        }
                }
                if {![dict exists $cred_opts -user]} {
                        dict unset cred_opts -password
                        dict unset cred_opts -domain
                }
                set ctx_opts {}
                foreach {type arg} {-target target} {
                        if {![catch "$ctx(callback) [list $context $arg]" res] && $res ne ""} {
                                dict set ctx_opts $type $res
                        }
                }
                set cred [::twapi::sspi_new_credentials -usage outbound -package $mech {*}$cred_opts]
                if {[catch {
                        set sspi_handles($context) [twapi::sspi_client_new_context $cred {*}$ctx_opts]
                } res opt]} {
                        ::twapi::sspi_free_credentials $cred
                        return -options $opt $res
                }
                ::twapi::sspi_free_credentials $cred
                trace add variable $context unset [list ::SASL::sspi::Cleanup $context]
        }
        set res [twapi::sspi_security_context_next $sspi_handles($context) $challenge]
        lassign $res cont ctx(response) sspi_handles($context)
        switch -exact -- $cont {
                continue {
                        return 1
                }
                done {
                        return 0
                }
        }
}

proc ::SASL::sspi::serverproc {mech context challenge args} {
        upvar #0 $context ctx
        variable sspi_handles
        if {$ctx(count) == 1} {
                # allocate twapi stuff..
                if {[info exists sspi_handles($context)]} {
                        sspi_close_security_context $sspi_handles($context)
                }
                set cred_opts {}
                foreach {type arg} {-user username -password password -domain realm} {
                        if {![catch "$ctx(callback) [list $context $arg]" res] && $res ne ""} {
                                dict set cred_opts $type $res
                        }
                }
                if {![dict exists $cred_opts -user]} {
                        dict unset cred_opts -password
                        dict unset cred_opts -domain
                }
                set ctx_opts {}
                foreach {type arg} {-target target} {
                        if {![catch "$ctx(callback) [list $context $arg]" res] && $res ne ""} {
                                dict set ctx_opts $type $res
                        }
                }
                set cred [::twapi::sspi_new_credentials -usage inbound -package $mech {*}$cred_opts]
                
                if {[catch {
                        set sspi_handles($context) [twapi::sspi_server_new_context $cred $challenge {*}$ctx_opts]
                } res opt]} {
                        ::twapi::sspi_free_credentials $cred
                        return -options $opt $res
                }
                ::twapi::sspi_free_credentials $cred
                trace add variable $context unset [list ::SASL::sspi::Cleanup $context]
                set res [twapi::sspi_security_context_next $sspi_handles($context) ""]
        } else {
                set res [twapi::sspi_security_context_next $sspi_handles($context) $challenge]
        }
        lassign $res cont ctx(response) sspi_handles($context)
        switch -exact -- $cont {
                continue {
                        return 1
                }
                done {
                        return 0
                }
        }
}

proc ::SASL::sspi::Init {} {
        foreach pkg [::twapi::sspi_enumerate_packages] {
                switch -exact -- $pkg {
                        Negotiate {set prio 100}
                        Kerberos {set prio 75}
                        NTLM {set prio 50}
                        default {set prio 49}
                }
                set ccmd [interp alias {} ::SASL::sspi::Client$pkg {} ::SASL::sspi::clientproc $pkg]
                set scmd [interp alias {} ::SASL::sspi::Server$pkg {} ::SASL::sspi::serverproc $pkg]
                ::SASL::register [string toupper $pkg] $prio $ccmd $scmd
                if {$pkg eq "Negotiate"} {
                        # Register as GSS-SPNEGO too
                        ::SASL::register GSS-SPNEGO 90 $ccmd $scmd
                }
        }
        rename ::SASL::sspi::Init {}
}
::SASL::sspi::Init

package provide SASL::sspi 1.0

JKU Some notes:

  • It used the non-standard parameter "target" for the SPN (necessary for Kerberos)
  • Server part not tested.
  • It always invokes the callback, not only if it needs some info. Return an empty string to use the default.
  • Not sure if I mapped the arguments correctly.
  • It uses traces to delete the twapi security context.
  • tcllibs SASL only supports uppercase mechanisms. You can register lowercase mechanisms, but you can not use them.
  • I guessed the priorities. Negotiate is IMHO the best, because it uses Kerberos and falls back to NTLM.

Example use:

package require ldap
package require SASL::sspi; # Imports twapi too.
set l [ldap::connect [string range [::twapi::find_domain_controller -require directoryservice] 2 end]]
ldap::bindSASL $l
foreach {k v} [lindex [ldap::search $l [::twapi::get_current_user -fullyqualifieddn] objectClass=* {} -scope base] 0 1] {puts "$k\t$v"}

schlenk Looks pretty good. Thats surely the correct and secure way to connect tcllib LDAP to an AD domain.

MHo 2019-01-19: What's the current state of the code above?

MHo 2019-01-22: I made a few changes from what I guess, only the client part for now:

# https://wiki.tcl-lang.org/page/SASL+and+TWAPI?V=6
package require SASL
package require twapi

namespace eval ::SASL::sspi {
        variable sspi_handles
        array set sspi_handles {}
}

proc ::SASL::sspi::Cleanup {ctx} {
        variable sspi_handles
        ::twapi::sspi_delete_context $sspi_handles($ctx)
        unset sspi_handles($ctx)
}

proc ::SASL::sspi::clientproc {mech context challenge args} {
        upvar #0 $context ctx
        variable sspi_handles
        if {$ctx(count) == 1} {
                if {[info exists sspi_handles($context)]} {
                        ::twapi::sspi_delete_context $sspi_handles($context)
                }
                # Try to get some values from the callback
                set cred_opts {}
                foreach {type arg} {-user username -password password -domain realm} {
                        if {![catch "$ctx(callback) [list $context $arg]" res] && $res ne ""} {
                                dict set cred_opts $type $res
                        }
                }
                if {![dict exists $cred_opts -user]} {
                        dict unset cred_opts -password
                        dict unset cred_opts -domain
                }
                set ctx_opts {}
                foreach {type arg} {-target target} {
                        if {![catch "$ctx(callback) [list $context $arg]" res] && $res ne ""} {
                                dict set ctx_opts $type $res
                        }
                }
                set cred [::twapi::sspi_acquire_credentials -role outbound -package $mech {*}$cred_opts]
                if {[catch {
                        set sspi_handles($context) [twapi::sspi_client_context $cred {*}$ctx_opts]
                } res opt]} {
                        ::twapi::sspi_free_credentials $cred
                        return -options $opt $res
                }
                ::twapi::sspi_free_credentials $cred
                trace add variable $context unset [list ::SASL::sspi::Cleanup $context]
        }
        set res [twapi::sspi_step $sspi_handles($context) $challenge]
        lassign $res cont ctx(response) sspi_handles($context)
        switch -exact -- $cont {
                continue {
                        return 1
                }
                done {
                        return 0
                }
        }
}

proc ::SASL::sspi::Init {} {
        foreach pkg [::twapi::sspi_enumerate_packages] {
                switch -exact -- $pkg {
                        Negotiate {set prio 100}
                        Kerberos {set prio 75}
                        NTLM {set prio 50}
                        default {set prio 49}
                }
                set ccmd [interp alias {} ::SASL::sspi::Client$pkg {} ::SASL::sspi::clientproc $pkg]
                ::SASL::register [string toupper $pkg] $prio $ccmd
                if {$pkg eq "Negotiate"} {
                        # Register as GSS-SPNEGO too
                        ::SASL::register GSS-SPNEGO 90 $ccmd
                }
        }
        rename ::SASL::sspi::Init {}
}
::SASL::sspi::Init

package provide SASL::sspi 1.0

Unfortunally, this didn't work for me...:

AUTH NTLM failed: Invalid option '-user'. Must be one of -credentials, -principal, -package, -role, -getexpiration

APN I wrote the SSPI support in TWAPI more than a decade ago and unfortunately do not remember details of the API. However, an obvious error is that you are passing the -user option to sspi_acquire_credentials which takes no such option. You need to pass the -credentials option instead with an appropriately constructed option value. See the docs for details.

Category Security
Updated 2019-01-28 11:19:38