Posted to tcl by schelte at Sun Jan 30 14:57:52 GMT 2011view raw

  1. #!/usr/bin/tclsh
  2. # -*- Tcl -*-
  3.  
  4. if {$argc != 1} {
  5. puts stderr "Usage: $argv0 <0|1>"
  6. exit 1
  7. }
  8.  
  9. set sw [string is true -strict [lindex $argv 0]]
  10.  
  11. set webcm http://fritz/cgi-bin/webcm
  12. set site ../html/de/menus/menu2.html
  13. set password secret
  14.  
  15. package require http
  16.  
  17. # Request a session ID
  18. set id [http::geturl $webcm?getpage=../html/login_sid.xml]
  19. set match [regexp -all -inline {<(\w+)>(\w*)</\1>} [http::data $id]]
  20. foreach {- prop value} $match {
  21. set session($prop) $value
  22. }
  23. http::cleanup $id
  24.  
  25. if {$session(iswriteaccess)} {
  26. # No password required
  27. set sid $session(SID)
  28. } else {
  29. # Calculate a response based on the challenge
  30. package require md5
  31. set data [encoding convertto unicode "$session(Challenge)-$password"]
  32. set md5 [string tolower [md5::md5 -hex $data]]
  33. set auth "$session(Challenge)-$md5"
  34. set query [http::formatQuery getpage $site login:command/response $auth]
  35. set id [http::geturl $webcm -query $query]
  36. set re {<input type="hidden" name="sid" value="(\w{16})" id="uiPostSid">}
  37. regexp $re [http::data $id] -> sid
  38. http::cleanup $id
  39. if {$sid eq "0000000000000000"} {
  40. puts stderr "Password was not accepted"
  41. exit 1
  42. }
  43. }
  44.  
  45. # Actually switch the WLAN on or off
  46. set query [http::formatQuery getpage $site sid $sid wlan:settings/ap_enabled $sw]
  47. set id [http::geturl $webcm -query $query]
  48. # puts [http::data $id]
  49. http::cleanup $id
  50. exit 0
  51.