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 [::twapi::sspi_new_credentials -usage inbound -package $mech]
                set sspi_handles($context) [twapi::sspi_server_new_context $cred $challenge]
                ::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