Planet
navi homePPSaboutscreenshotsdownloaddevelopmentforum

source: code/branches/menuanimations/data/tcl/irk/lib/irkauth.tcl @ 6937

Last change on this file since 6937 was 5781, checked in by rgrieder, 15 years ago

Reverted trunk again. We might want to find a way to delete these revisions again (x3n's changes are still available as diff in the commit mails).

  • Property svn:eol-style set to native
File size: 7.8 KB
Line 
1# irkauth.tcl:
2#
3# Various procedures that deal with user authentication:
4
5namespace eval ::irk {
6
7    # The AUTH module keeps information about each user and facility ($fac)
8    # in the state array:
9    #
10    # auth(auth,$fac,$user)             If set, then $user has authenticated
11    #                                   successfully for the facility $fac.
12    # auth(user,$fac,$user,pass)        The password for this $user and $fac.
13    # auth(user,$fac,$user,ident)       The ident token for this $user & $fac.
14    #
15    # auth(ident,$fac,$ident,pass)      The password for this $ident and $fac.
16    # auth(ident,$fac,$ident,user)      The user for this $ident and $fac.
17    #
18    # auth(identcounter,$fac)           The ident token counter for $fac. This
19    #                                   is incremented each time a new user
20    #                                   establishes themselves with $fac.
21
22    # This procedure can be called by programs using the IRK library
23    # when a user sends a password.
24
25    proc pass {token fac nick user rest} {
26        variable auth
27
28        if {[llength $rest] != 1} {
29            # Incorrect syntax:
30
31            set reply "$nick, syntax is !pass <yourpass> (one word, no spaces)"
32        } elseif {[info exists auth(user,$fac,$user,pass)]} {
33
34            # If this user has already established a password,
35            # check that they're giving the right password.
36
37            if {[string compare $auth(user,$fac,$user,pass) \
38                                [lindex $rest 0]]} {
39                set reply "$nick, sorry, wrong password!"
40            } else {
41                set reply "$nick, thanks for entering your password!"
42                set auth(auth,$fac,$user) 1
43            }
44        } else {
45
46            # This is the first time we're seeing this user. Accept
47            # their password and send them an ident token. They can
48            # use the ident token to reestablish themselves when their
49            # user mask changes significantly.
50
51            if {![info exists auth(identcounter,$fac)]} {
52                set auth(identcounter,$fac) 0
53            }
54            set ident $auth(identcounter,$fac)
55            incr auth(identcounter,$fac)
56
57            set auth(ident,$fac,$ident,user) $user
58            set auth(ident,$fac,$ident,pass) [lindex $rest 0]
59
60            set auth(user,$fac,$user,ident) $ident
61            set auth(user,$fac,$user,pass) [lindex $rest 0]
62
63            # Save the changes
64
65            saveauth
66
67            # Save them a step and also authorize them:
68
69            set auth(ident,$fac,$user) 1
70
71            set reply [list \
72                $nick, your password is [lindex $rest 0]. Your ident is \
73                $ident, write it down, you will need it later to \
74                reidentify yourself if your user mask changes. \
75                You user mask is currently $user. You are now authorised \
76                to use $fac.]
77        }
78
79        # Tell them what happened:
80
81        ::irk::say $token $nick $reply
82
83        return ""
84    }
85
86    # This procedure can be called by programs when the user attempts to
87    # reestablish themselves with the existing ident and password.
88
89    proc id {token fac nick user rest} {
90        variable auth
91
92        set len [llength $rest]
93        set reply "Wrong syntax. Call !ident or !ident <ident> <pass>"
94
95        if {$len == 0} {
96
97            # Calling ident with zero arguments. The user is trying to
98            # retrieve their ident. Give it to them only if they did
99            # identify successfully with the correct password.
100
101            if {![info exists auth(user,$fac,$user,pass)]} {
102                set reply "$nick, first set a password"
103            } elseif {[info exists auth(auth,$fac,$user)]} {
104                set reply \
105                    "$nick, your ident is $auth(user,$fac,$user,ident)"
106            } else {
107                set reply \
108                   "$nick, identify with password before getting your ident!"
109            }
110        } elseif {$len == 2} {
111
112            # Calling ident with two arguments. The user is trying to
113            # establish a new value for $user to associate with this
114            # ident and password. If $auth($ident,pass) is the password
115            # she gave, then they're the rightfull owner of the ident and
116            # so we now recognize the new $user mask.
117
118            set ident [lindex $rest 0]
119            set pass [lindex $rest 1]
120
121            if {[info exists auth(ident,$fac,$ident,pass)]} {
122                if {![string compare $auth(ident,$fac,$ident,pass) $pass]} {
123
124                    # Identify the old user mask they were using:
125
126                    set olduser $auth(ident,$fac,$ident,user)
127
128                    # Clean up the state associated with the old mask:
129
130                    array unset auth user,$fac,$olduser,*
131                    catch {unset auth(ident,$face,$olduser)}
132
133                    # Link up the new state:
134
135                    set auth(ident,$fac,$ident,user) $user
136
137                    set auth(user,$fac,$user,ident) $ident
138                    set auth(user,$fac,$user,pass) $pass
139
140                    # Save the changes
141
142                    saveauth
143
144                    # Save them a step and also treat them as authenticated:
145
146                    set auth(ident,$fac,$user) 1
147
148                    set reply \
149                            "OK, $nick, I'm now recognising you as $user.\
150                             You are now authorised to use $fac."
151                } else {
152                    set reply "$nick, sorry, wrong ident or password"
153                }
154            } else {
155                set reply "$nick, sorry, wrong ident or password"
156            }
157        }
158
159        # Tell them what happened:
160
161        ::irk::say $token $nick $reply
162
163        return ""
164    }
165
166    # This procedure can be invoked by a program when a user tries to
167    # change her password.
168
169    proc np {token fac nick user rest} {
170        variable auth
171
172        set reply "Wrong syntax. Call !newpass <oldpass> <newpass>"
173
174        if {[llength $rest] == 2} {
175            set opw [lindex $rest 0]
176            set npw [lindex $rest 1]
177
178            if {![info exists auth(user,$fac,$user,pass)]} {
179                # Unknown $user, probably their user mask changed. Help
180                # them reestablish the connection.
181
182                set reply \
183                   [list $nick, I don't have you in my database. Perhaps \
184                         your user mask changed drastically. If so, please \
185                         reestablish your user mask by using !ident <ident> \
186                         <oldpass>.]
187            } elseif {[string compare $auth(user,$fac,$user,pass) $opw]} {
188                # Wrong old password!
189
190                set reply "$nick, sorry, wrong old password!"
191            } else {
192                # Their user mask matches and they gave the correct old
193                # password, so we accept their new password:
194
195                set ident $auth(user,$fac,$user,ident)
196
197                set auth(ident,$fac,$ident,pass) $npw
198                set auth(user,$fac,$user,pass) $npw
199
200                # Save the changes:
201
202                saveauth
203
204                # Save them a step by also recording that they
205                # authenticated:
206
207                set auth(auth,$fac,$user) 1
208
209                set reply "OK, $nick, your new password is now $npw"
210            }
211        }
212
213        # Tell them what happened:
214
215        ::irk::say $token $nick $reply
216
217        return ""
218    }
219
220    # This procedure can be called by programs when the user wants to
221    # "log out" or lose her authentication with a given facility:
222
223    proc logout {token fac nick user rest} {
224        variable auth
225
226        set reply "You were not logged into $fac. Now you certainly aren't."
227
228        if {[info exists auth(auth,$fac,$user)]} {
229            unset auth(auth,$fac,$user)
230
231            set reply \
232                [list $nick, you logged out successfully from $fac. Thank you \
233                      for using $fac.]
234        }
235
236        # Tell them what happened:
237
238        ::irk::say $token $nick $reply
239
240        return ""
241    }
242
243    # Is the user authenticated with the given facility?
244
245    proc userauthenticated {fac user} {
246        variable auth
247
248        # If auth(auth,$fac,$user) exists, then she is authenticated.
249
250        if {[info exists auth(auth,$fac,$user)]} {
251            return 1
252        }
253        return 0
254    }
255
256    # This procedure automatically saves the authorization database:
257
258    proc saveauth {} {
259        variable state
260        variable auth
261
262        puts "Saving!"
263
264        # Define the patterns to save:
265
266        set p1 "identcounter,*"
267        set p2 "user,*"
268        set p3 "ident,*"
269
270        # Try to open the save file:
271
272        if {[info exists state(auth,save,file)]} {
273            if {![catch {set fd [open $state(auth,save,file) w]}]} {
274                puts $fd "array set ::irk::auth [list [array get auth $p1]]"
275                puts $fd "array set ::irk::auth [list [array get auth $p2]]"
276                puts $fd "array set ::irk::auth [list [array get auth $p3]]"
277
278                catch {close $fd}
279            }
280        }
281    }
282
283    # This procedure restores the authorization database:
284
285    proc restoreauth {} {
286        variable state
287
288        if {[info exists state(auth,save,file)]} {
289            catch {uplevel #0 source $state(auth,save,file)}
290        }
291        set state(auth,restored) 1
292    }
293
294    # If this is the first time we're loading the IRK package, then
295    # restore the authorization database. Otherwise we'd be overwriting
296    # a potentially unsaved state.
297
298    variable state
299
300    if {![info exists state(auth,restored)]} {
301        restoreauth
302    }
303}
Note: See TracBrowser for help on using the repository browser.