Control Fritz!box wlan

#!/usr/bin/tclsh
# -*- Tcl -*-

if {$argc != 1} {
    puts stderr "Usage: $argv0 <0|1>"
    exit 1
}

set sw [string is true -strict [lindex $argv 0]]

set webcm http://fritz/cgi-bin/webcm
set site ../html/de/menus/menu2.html
set password secret

package require http

# Request a session ID
set id [http::geturl $webcm?getpage=../html/login_sid.xml]
set match [regexp -all -inline {<(\w+)>(\w*)</\1>} [http::data $id]]
foreach {- prop value} $match {
    set session($prop) $value
}
http::cleanup $id

if {$session(iswriteaccess)} {
    # No password required
    set sid $session(SID)
} else {
    # Calculate a response based on the challenge
    package require md5
    set data [encoding convertto unicode "$session(Challenge)-$password"]
    set md5 [string tolower [md5::md5 -hex $data]]
    set auth "$session(Challenge)-$md5"
    set query [http::formatQuery getpage $site login:command/response $auth]
    set id [http::geturl $webcm -query $query]
    set re {<input type="hidden" name="sid" value="(\w{16})" id="uiPostSid">}
    regexp $re [http::data $id] -> sid
    http::cleanup $id
    if {$sid eq "0000000000000000"} {
        puts stderr "Password was not accepted"
        exit 1
    }
}

# Actually switch the WLAN on or off
set query [http::formatQuery getpage $site sid $sid wlan:settings/ap_enabled $sw]
set id [http::geturl $webcm -query $query]
# puts [http::data $id]
http::cleanup $id
exit 0