sec_login_read_cookie (private)

 sec_login_read_cookie

Defined in packages/acs-tcl/tcl/security-procs.tcl

Fetches values either from "user_login_secure" or "user_login" cookies, depending whether we are in a secured connection or not.

Returns:

dict of values from cookie "user_login_secure" or "user_login". Additionally, the dict contains a member "status" with possible values "OK", "NO_COOKIE" or "INVALID_COOKIE"

Author:

Victor Guerra

Partial Call Graph (max 5 caller/called nodes):

Testcases:

No testcase defined.

Source code:

    #
    # ad_user_login         user_id,issue_time,auth_token,forever,external_registry
    # ad_user_login_secure  user_id,issue_time,auth_token,random,forever,external_registry
    #
    # If over HTTPS, we look for the *_secure cookie
    #
    if { [security::secure_conn_p] || [ad_conn behind_secure_proxy_p]} {
        set cookie_name [security::cookie_name user_login_secure]
        set expect_elements 6
    } else {
        set cookie_name [security::cookie_name user_login]
        set expect_elements 5
    }

    #
    # Provide default values for the result.
    #
    set result {
        user_id 0
        issue_time 0
        auth_token ""
        forever_p 0
        external_registry ""
        status NO_COOKIE
    }

    try {
        ad_get_signed_cookie $cookie_name

    } trap {AD_EXCEPTION NO_COOKIE} {errorMsg} {
        dict set result status NO_COOKIE

    } trap {AD_EXCEPTION INVALID_COOKIE} {errorMsg} {
        dict set result status INVALID_COOKIE

    } on ok {cookie_value} {
        set login_list [split $cookie_value ","]
        dict set result status OK
        dict set result user_id    [lindex $login_list 0]
        dict set result issue_time [lindex $login_list 1]
        dict set result auth_token [lindex $login_list 2]

        if {[llength $login_list] == $expect_elements} {
            dict set result forever_p  [lindex $login_list end-1]
            dict set result external_registry [lindex $login_list end]
        } else {
            #
            # Legacy case (no external registry is provided). This is
            # just needed for the transition phase, while still old
            # cookies are in use, having no "external_registry"
            # defined.
            #
            dict set result forever_p  [lindex $login_list end]
            dict set result external_registry ""
        }
    }
    return $result

Generic XQL file:

packages/acs-tcl/tcl/security-procs.xql

PostgreSQL XQL file:

packages/acs-tcl/tcl/security-procs-postgresql.xql

Oracle XQL file:

packages/acs-tcl/tcl/security-procs-oracle.xql