Question

使用tcl http包我使用所需的凭据连接到url。之后我想发送一个查询，但是geturl proc没有使用现有令牌id的选项。

set auth "Basic [base64::encode test:test123]"
set headerl [list Authorization $auth]
set tok [http::geturl http://192.168.2.77:9001 -headers $headerl -timeout 10000 -type text/html]
http::wait $tok
if {![string compare [http::status $tok] "ok"]} {
    puts [http::data $tok]
} else {
    puts stderr [http::error $tok]
}

这里我想发送后续页面的查询，但我找不到这样做的选项

如果我再次冒险，那么就会发出错误，说授权失败了。

set tok [http::geturl http://192.168.4.77:9001/index.html?action=stopall -timeout 10000 -type text/html]
http::wait $tok
if {![string compare [http::status $tok] "ok"]} {
    puts [http::data $tok]
} else {
    puts stderr [http::error $tok]
}

<head>
<title>Error response</title>
</head>
<body>
<h1>Error response</h1>
<p>Error code 401.
<p>Message: Unauthorized.
</body>

提前致谢

Answer 1

您需要一个用于保存响应cookie的cookie jar。这是一个将jar添加到jar并将其发回的示例。请注意，它不会检查您需要执行的cookie属性，以避免暴露会话密钥。

#!/usr/bin/tclsh

package require http

proc wget {url {jarname COOKIE_JAR}} {

    set o_headers {User-Agent {Mozilla/5.0 (compatible; MSIE 10.0; Windows NT 6.1; Trident/6.0)}}
    upvar $jarname cookiejar
    set cookies [list]

    # WARNING - Blindly sending cookies in jar. You chould check attributes.
    # domain, path, expires, httponly, secure, max-age

    # Adding cookiename=value without attributes. Attributes aren't for sending.
    foreach {value} $cookiejar {lappend cookies [lindex [split $value ";"] 0]}

    # Add cookies to the header.
    lappend o_headers "Cookie" [join $cookies "; "]

    set tok [::http::geturl $url -timeout 10000 -method GET -query "" -headers $o_headers]

    # add/replace cookies in the return headers.
    foreach {key value} [::http::meta $tok] {
        if {[string tolower $key] != "set-cookie"} {continue}

        set cookie_key [lindex [regexp -inline {\s*([^=]+)} $value] 1]

        if {[set index [lsearch -glob $cookiejar "$cookie_key=*"]] != -1} {
            # Replace if cookie already exists
            lset cookiejar $index $value
            continue
        }

        lappend cookiejar $value
    }

    return [::http::data $tok]
}

set google_cookies [list]
set page http://www.google.com
puts "Cookies before request.\n$google_cookies"
wget $page google_cookies
puts "Cookies after request.\n$google_cookies"

输出：

./wget
Cookies before request.

Cookies after request.
{PREF=ID=xxx:FF=0:TM=xxx:LM=xx:S=xxx-xxx; expires=Sun, 18-Dec-2016 02:26:37 GMT; path=/; domain=.google.com} {NID=12=x_xx_xxx-xxxx_xxxxx; expires=Sat, 20-Jun-2015 02:26:37 GMT; path=/; domain=.google.com; HttpOnly}

如何在tcl http中保持会话打开

1 个答案: