acs::test::http (public)

 acs::test::http [ -user_id user_id ] [ -user_info user_info ] \
    [ -last_request last_request ] [ -method method ] [ -body body ] \
    [ -timeout timeout ] [ -depth depth ] [ -headers headers ] \
    [ -prefix prefix ] [ -verbose ] [ -basic_auth ] request

Defined in packages/acs-automated-testing/tcl/aa-test-procs.tcl

Run an HTTP request against the actual server inside test cases.

Switches:
-user_id (optional, defaults to "0")
-user_info (optional)
-last_request (optional)
-method (optional, defaults to "GET")
-body (optional)
-timeout (optional, defaults to "10")
-depth (optional, defaults to "1")
follow redirects up to specified depth. Default means redirects won't be followed.
-headers (optional)
-prefix (optional)
-verbose (optional, boolean, defaults to "true")
-basic_auth (optional, boolean, defaults to "false")
Parameters:
request (required)
Author:
Gustaf Neumann

Partial Call Graph (max 5 caller/called nodes):
%3 test_ad_context_bar_multirow ad_context_bar_multirow (test acs-tcl) acs::test::http acs::test::http test_ad_context_bar_multirow->acs::test::http test_create_form_with_form_instance create_form_with_form_instance (test xowiki) test_create_form_with_form_instance->acs::test::http test_create_form_with_numeric create_form_with_numeric (test xowiki) test_create_form_with_numeric->acs::test::http test_form_validate form_validate (test xowiki) test_form_validate->acs::test::http test_front_page_1 front_page_1 (test acs-tcl) test_front_page_1->acs::test::http aa_log aa_log (public) acs::test::http->aa_log acs::test::set_user acs::test::set_user (private) acs::test::http->acs::test::set_user acs::test::url acs::test::url (public) acs::test::http->acs::test::url acs::test::confirm_email acs::test::confirm_email (public) acs::test::confirm_email->acs::test::http acs::test::follow_link acs::test::follow_link (public) acs::test::follow_link->acs::test::http acs::test::form_reply acs::test::form_reply (public) acs::test::form_reply->acs::test::http acs::test::login acs::test::login (public) acs::test::login->acs::test::http acs::test::logout acs::test::logout (public) acs::test::logout->acs::test::http

Testcases:
webtest_example, password_recovery_page, front_page_1, ad_context_bar_multirow, create_form_with_form_instance, create_form_with_numeric, form_validate, nested_self_references
Source code:
        ns_log notice "::acs::test::http -user_id '$user_id' -user_info '$user_info' request '$request'"
        set session ""
        if {[dict exists $last_request session]} {
            set session [dict get $last_request session]
        }
        if {$user_info eq "" && [dict exists $session user_info]} {
            set user_info [dict get $last_request session user_info]
            #aa_log "user_info from last_request [ns_quotehtml <$user_info>]"
        }
        #aa_log "HTTP: user_info [ns_quotehtml <$user_info>]"
        #aa_log "HTTP: start session_info [ns_quotehtml <$session>]"

        set test_url [acs::test::url]
        set urlInfo [ns_parseurl $test_url]
        set address [dict get $urlInfo host]
        set url ${test_url}/${request}

        #
        # Either authenticate via user_info (when specified) or via
        # user_id.
        #
        if {$user_info ne ""} {
        } else {
            dict set user_info user_id $user_id
            dict set user_info address $address
        }

        set session [::acs::test::set_user -session $session $user_info]
    ns_log notice "Session after set_user '$user_info': $session"
        set login [dict get $session login]

        if {[dict exists $session cookies]} {
            lappend headers Cookie [dict get $session cookies]
        }

        set extra_args {}
        if {[info exists body]} {
            lappend extra_args -body $body
        }

        if {[dict exists $user_info email]
            && [dict exists $user_info password]
        } {
            set ah [ns_base64encode [dict get $user_info email]:[dict get $user_info password]]
            aa_log "... user_info $user_info AH $ah"
            lappend headers Authorization "Basic $ah"
        }

        if {[llength $headers] > 0} {
            set requestHeaders [ns_set create]
            foreach {tag value} $headers {
                ns_set update $requestHeaders $tag $value
            }
            lappend extra_args -headers $requestHeaders
        }

        #
        # Construct a nice log line
        #
        append log_line "${prefix}Run $method $request"
        if {[llength $headers] > 0} {
            append log_line " (headers: $headers)"
        }
        if {[info exists body]} {
            append log_line "<pre>\n[ns_quotehtml $body]</pre>"
        }
        aa_log $log_line

        #
        # Run actual request
        #
        set d ""
        try {
            set location $url
            while {$depth > 0} {
                ns_log notice "acs::test::http client request (timeout $timeout): $method $location"
                incr depth -1
                set d [ns_http run  -timeout $timeout  -method $method  {*}$extra_args  $location]
                set status   [dict get $d status]
                set location [ns_set iget [dict get $d headers] location]
                if {![string match "3??" $status] || $location eq ""} {
                    break
                }

                #
                # According to
                # https://www.rfc-editor.org/rfc/rfc7231#section-7.1.2,
                # the location header may return a relative URL as
                # well.
                #
                set location [ns_absoluteurl $location $test_url]
            }
        } finally {
            #
            # always reset after the request the login data nsv
            #
            nsv_unset -nocomplain aa_test logindata
        }

        #ns_log notice "run $request returns $d"
        #ns_log notice "... [ns_set array [dict get $d headers]]"

        if {$verbose_p} {
            set ms [format %.2f [expr {[ns_time format [dict get $d time]] * 1000.0}]]
            aa_log "${prefix}$method $request returns [dict get $d status] in ${ms}ms"
        }

        #aa_log "REPLY has headers [dict exists $d headers]"
        if {[dict exists $d headers]} {
            set cookies {}
            set cookie_dict {}
            if {[dict exists $last_request cookies]} {
                #
                # Merge last request cookies
                #
                foreach cookie [split [dict get $last_request cookies] ";"] {
                    lassign [split [string trim $cookie] =] name value
                    dict set cookie_dict $name $value
                    #aa_log "merge last request cookie $name $value"
                }
            } else {
                #aa_log "last_req has no cookies"
            }
            if {[dict exists $session cookies]} {
                #
                # Merge session cookies (e.g. from a called login
                # inside :acs::test::set_user)
                #
                foreach cookie [split [dict get $session cookies] ";"] {
                    lassign [split [string trim $cookie] =] name value
                    dict set cookie_dict $name $value
                    #aa_log "merge session cookie $name $value"
                }
            }
            #
            # Merge fresh cookies
            #
            foreach {tag value} [ns_set array [dict get $d headers]] {
                #aa_log "received header $tag: $value"
                if {$tag eq "set-cookie"} {
                    if {[regexp {^([^;]+);} $value . cookie]} {
                        lassign [split [string trim $cookie] =] name value
                        dict set cookie_dict $name $value
                        aa_log "merge fresh cookie $name $value"
                    } else {
                        aa_log "Cookie has invalid syntax: $value"
                    }
                }
            }
            foreach cookie_name [dict keys $cookie_dict] {
                lappend cookies $cookie_name=[dict get $cookie_dict $cookie_name]
            }
            dict set d session cookies [join $cookies ";"]
        }
        dict set d login $login
        dict set d session user_info $user_info
        #aa_log "HTTP: URL $url final session_info [ns_quotehtml <[dict get $d session]>]"

        return $d
XQL Not present:
Generic, PostgreSQL, Oracle
[ hide source ] | [ make this the default ]
Show another procedure: