← Back to branch summary

~ubuntu-branches/ubuntu/saucy/amsn/saucy

« back to all changes in this revision

Viewing changes to utils/sasl/gtoken.tcl

  • Committer: Bazaar Package Importer
  • Author(s): Devid Antonio Filoni
  • Date: 2010-04-13 23:21:29 UTC
  • mfrom: (1.1.11 upstream) (3.1.8 sid)
  • Revision ID: james.westby@ubuntu.com-20100413232129-vgpx20brdd2qavs7
Tags: 0.98.3-0ubuntu1
https://launchpad.net/bugs/449072
https://launchpad.net/bugs/562619
* Merge from Debian unstable (LP: #449072), remaining Ubuntu changes:
  - add 08_use_aplay_for_sound.dpatch patch by Festor Wailon Dacoba to use
    aplay to play sounds
  + debian/control:
    - modify iceweasel to firefox | abrowser in amsn Suggests field
    - add xdg-utils and gstreamer0.10-nice to amsn Depends field
    - mofify sox to alsa-utils in amsn Suggests field as we are now using
      aplay
* New upstream release (LP: #562619), tarball repacked according to
  debian/README.source.
* Fix missing-debian-source-format lintian warning.

Show diffs side-by-side

added added

removed removed

Lines of Context:
utils/sasl/gtoken.tcl
 
1
# gtoken.tcl - Copyright (C) 2006 Pat Thoyts <patthoyts@users.sourceforge.net>
 
2
#
 
3
# This is an implementation of Google's X-GOOGLE-TOKEN authentication 
 
4
# mechanism. This actually passes the login details to the Google
 
5
# accounts server which gives us a short lived token that may be passed 
 
6
# over an insecure link.
 
7
#
 
8
# -------------------------------------------------------------------------
 
9
# See the file "license.terms" for information on usage and redistribution
 
10
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
11
# -------------------------------------------------------------------------
 
12
 
 
13
package require Tcl 8.2
 
14
package require SASL
 
15
package require http
 
16
package require tls
 
17
 
 
18
namespace eval ::SASL {
 
19
    namespace eval XGoogleToken {
 
20
        variable version 1.0.1
 
21
        variable rcsid {$Id: gtoken.tcl,v 1.4 2007/08/26 00:36:45 patthoyts Exp $}
 
22
        variable URLa https://www.google.com/accounts/ClientAuth
 
23
        variable URLb https://www.google.com/accounts/IssueAuthToken
 
24
 
 
25
        # Should use autoproxy and register autoproxy::tls_socket
 
26
        # Leave to application author?
 
27
        if {![info exists ::http::urlTypes(https)]} {
 
28
            http::register https 443 tls::socket
 
29
        }
 
30
    }
 
31
}
 
32
 
 
33
proc ::SASL::XGoogleToken::client {context challenge args} {
 
34
    upvar #0 $context ctx
 
35
    variable URLa
 
36
    variable URLb
 
37
    set reply ""
 
38
    set err ""
 
39
 
 
40
    if {$ctx(step) != 0} {
 
41
        return -code error "unexpected state: X-GOOGLE-TOKEN has only 1 step"
 
42
    }
 
43
    set username [eval $ctx(callback) [list $context username]]
 
44
    set password [eval $ctx(callback) [list $context password]]
 
45
    set query [http::formatQuery Email $username Passwd $password \
 
46
                   PersistentCookie false source googletalk]
 
47
    set tok [http::geturl $URLa -query $query -timeout 30000]
 
48
    if {[http::status $tok] eq "ok"} {
 
49
        foreach line [split [http::data $tok] \n] {
 
50
            array set g [split $line =]
 
51
        }
 
52
        if {![info exists g(Error)]} {
 
53
            set query [http::formatQuery SID $g(SID) LSID $g(LSID) \
 
54
                           service mail Session true]
 
55
            set tok2 [http::geturl $URLb -query $query -timeout 30000]
 
56
 
 
57
            if {[http::status $tok2] eq "ok"} {
 
58
                set reply "\0$username\0[http::data $tok2]"
 
59
            } else {
 
60
                set err [http::error $tok2]
 
61
            }
 
62
            http::cleanup $tok2
 
63
       } else {
 
64
           set err "Invalid username or password"
 
65
       }
 
66
    } else {
 
67
        set err [http::error $tok]
 
68
    }
 
69
    http::cleanup $tok
 
70
    
 
71
    if {[string length $err] > 0} {
 
72
        return -code error $err
 
73
    } else {
 
74
        set ctx(response) $reply
 
75
        incr ctx(step)
 
76
    }
 
77
    return 0
 
78
}
 
79
 
 
80
# -------------------------------------------------------------------------
 
81
 
 
82
# Register this SASL mechanism with the Tcllib SASL package.
 
83
#
 
84
if {[llength [package provide SASL]] != 0} {
 
85
    ::SASL::register X-GOOGLE-TOKEN 40 ::SASL::XGoogleToken::client
 
86
}
 
87
 
 
88
package provide SASL::XGoogleToken $::SASL::XGoogleToken::version
 
89
 
 
90
# -------------------------------------------------------------------------
 
91
#
 
92
# Local variables:
 
93
# indent-tabs-mode: nil
 
94
# End: