1# $Id$
2
3namespace eval otr {
4    # Prepare to load the local TclOTR library
5
6    set scriptdir [file dirname [info script]]
7    set tclotr [file join $scriptdir tclotr]
8
9    if {[file isdirectory $tclotr]} {
10	lappend ::auto_path $scriptdir
11	package forget otr
12    }
13
14    # Load message catalogs:
15
16    package require msgcat
17    ::msgcat::mcload [file join $scriptdir msgs]
18    ::trans::load [file join $scriptdir trans]
19
20    # Check if Tkabber is sufficiently new
21
22    if {[hook::is_empty send_normal_message_hook]} {
23	puts stderr [::msgcat::mc "Tkabber is too old for the OTR plugin"]
24	# Clean up what's already here and bail out:
25	namespace delete [namespace current]
26	return
27    }
28
29    # Attempt to load TclOTR. Warn and quit loading plugin if we can't:
30
31    if {[catch { package require otr } err]} {
32	puts stderr $err
33	puts stderr [::msgcat::mc "Problem loading TclOTR. The OTR\
34				   functionality will be disabled.\nRefer\
35				   to the README file of the OTR plugin."]
36	# Clean up what's already here and bail out:
37	namespace delete [namespace current]
38	return
39    }
40
41    # Load DSA keys and authenticaton infrastructure
42
43    source [file join $scriptdir auth.tcl]
44    source [file join $scriptdir key.tcl]
45
46    # Auxiliary namespace. Rewrite_message_hook will use it to add some
47    # supplemetary info.
48
49    set ns tkabber:otr
50
51    # PLugin's options
52
53    variable options
54
55    variable themes
56    set dirs \
57	[glob -nocomplain -directory [file join [file dirname [info script]] \
58						pixmaps] *]
59    foreach dir $dirs {
60	pixmaps::load_theme_name [namespace current]::themes $dir
61    }
62    set values {}
63    foreach theme [lsort [array names themes]] {
64	lappend values $theme $theme
65    }
66
67    custom::defgroup Plugins [::msgcat::mc "Plugins options."] \
68	-group Tkabber
69
70    custom::defgroup OTR [::msgcat::mc "Off-the-record messaging plugin options."] \
71	-group Plugins
72
73    custom::defvar options(theme) OTR \
74	[::msgcat::mc "OTR icons theme."] -group OTR \
75	-type options -values $values \
76	-command [namespace current]::load_stored_theme
77
78    custom::defvar options(allow-encryption) 1 \
79	[::msgcat::mc "Allow Tkabber to use Off-the-Record protocol (version 2 or 3)."] \
80	-group OTR -type boolean -command [namespace current]::update_default_policy
81
82    custom::defvar options(require-encryption) 0 \
83	[::msgcat::mc "Refuse to send unencrypted messages. Note that if this option\
84		       is enabled and the previous one is not then you will not be\
85		       able to send any chat or normal messages at all"] \
86	-group OTR -type boolean -command [namespace current]::update_default_policy
87
88    custom::defvar options(send-whitespace-tag) 1 \
89	[::msgcat::mc "Advertise your support of OTR using the whitespace tag."] \
90	-group OTR -type boolean -command [namespace current]::update_default_policy
91
92    custom::defvar options(whitespace-or-error-start-ake) 1 \
93	[::msgcat::mc "Start the OTR authenticated key exchange when you\
94		       receive a whitespace tag or an OTR error message."] \
95	-group OTR -type boolean -command [namespace current]::update_default_policy
96
97    custom::defvar options(heartbeat-interval) 60 \
98	[::msgcat::mc "If the interval between two consecutive incoming OTR messages\
99		       exceeds the specified interval (in minutes, zero means no\
100		       heartbeat at all) the heartbeat message will be sent to\
101		       change the session keys."] \
102	-group OTR -type integer -command [namespace current]::update_heartbeat
103
104    custom::defvar options(dont-log-otr-messages) 0 \
105	[::msgcat::mc "Do not log OTR messages."] \
106	-group OTR -type boolean
107
108    # Hidden option for storing contacts' personal preferences
109    # {myjid1 {jid1 {allow-encryption 0 ...} jid2 {...}} myjid2 {jid1 {...} jid2 {...}}}
110
111    custom::defvar options(personal-preferences) {} \
112	[::msgcat::mc "Presonal OTR preferences."] \
113	-type string -group Hidden
114
115    # Correspondence between GUI options and OTR policy flags
116
117    array set PolicyFlags {allow-encryption {ALLOW_V2 ALLOW_V3}
118			   require-encryption {REQUIRE_ENCRYPTION}
119			   send-whitespace-tag {SEND_WHITESPACE_TAG}
120			   whitespace-or-error-start-ake {WHITESPACE_START_AKE ERROR_START_AKE}}
121}
122
123#############################################################################
124
125proc otr::load_stored_theme {args} {
126    variable options
127    variable themes
128
129    pixmaps::load_dir $themes($options(theme))
130}
131
132#############################################################################
133
134proc otr::draw_encrypted {chatid from type body x} {
135    variable ns
136    variable ctx
137
138    if {$type ne "chat"} return
139
140    set xlib [chat::get_xlib $chatid]
141    set jid [chat::get_jid $chatid]
142
143    if {![::xmpp::jid::equal $jid $from]} return
144
145    foreach xe $x {
146	::xmpp::xml::split $xe tag xmlns attrs cdata subels
147
148	if {$tag eq "" && $xmlns eq $ns} {
149	    set chatw [chat::chat_win $chatid]
150	    $chatw image create end -image [::xmpp::xml::getAttr $attrs icon]
151	    break
152	}
153    }
154}
155
156hook::add draw_message_hook [namespace current]::otr::draw_encrypted 6
157
158#############################################################################
159
160proc otr::process_x_encrypted {rowvar bodyvar f x xlib from id type replyP} {
161    variable ns
162    variable ctx
163    upvar 2 $rowvar row
164    upvar 2 $bodyvar body
165
166    if {$type eq "error" || $type eq "groupchat" || $type eq "headline"} return
167
168    if {$body eq ""} return
169
170    foreach xe $x {
171	::xmpp::xml::split $xe tag xmlns attrs cdata subels
172
173	if {$tag eq "" && $xmlns eq $ns} {
174	    set lb [join [lrange [split $f .] 0 end-1] .].title.otrmsgstate
175	    if {[winfo exists $lb]} {
176		destroy $lb
177	    }
178	    Label $lb -image [::xmpp::xml::getAttr $attrs icon]
179	    grid $lb -row 1 -column 4 -sticky e
180	    break
181	}
182    }
183}
184
185hook::add message_process_x_hook [namespace current]::otr::process_x_encrypted 21
186
187#############################################################################
188
189proc otr::once_only {xlib jid} {
190    variable options
191    variable ctx
192
193    if {[info exists ctx($xlib,$jid)]} {
194	return 1
195    }
196
197    debugmsg otr "ONCE_ONLY $xlib $jid"
198
199    set myjid [::xmpp::jid::removeResource [connection_jid $xlib]]
200    set privkey [key::get_key $key::Keys $myjid]
201    if {[llength $privkey] == 0} {
202	return 0
203    }
204
205    set ctx(msgstate,$xlib,$jid) MSGSTATE_PLAINTEXT
206    msgstate:trace {} $xlib $jid
207
208    set ctx($xlib,$jid) \
209	[::otr::new $privkey \
210		-policy [get_policy $xlib $jid] \
211		-heartbeat $options(heartbeat-interval) \
212		-authstatecommand [namespace code [list on_authstate_change $xlib $jid]] \
213		-msgstatecommand [namespace code [list on_msgstate_change $xlib $jid]] \
214		-smpstatecommand [namespace code [list on_smpstate_change $xlib $jid]] \
215		-smpprogresscommand [namespace code [list progress_smp $xlib $jid]] \
216		-infocommand [namespace code [list show_info $xlib $jid]] \
217		-errorcommand [namespace code [list show_error $xlib $jid]] \
218		-sendcommand [namespace code [list send $xlib $jid]]]
219    return 1
220}
221
222proc otr::clear {xlib jid} {
223    variable ctx
224
225    if {[info exists ctx($xlib,$jid)]} {
226	finish_session $xlib $jid ""
227	::otr::free $ctx($xlib,$jid)
228	unset ctx(authstate,$xlib,$jid)
229	unset ctx(msgstate,$xlib,$jid)
230	unset ctx(smpstate,$xlib,$jid)
231	unset ctx($xlib,$jid)
232
233	set chatid [chat::chatid $xlib $jid]
234	set chatw [chat::chat_win $chatid]
235	if {![winfo exists $chatw]} return
236
237	if {[key::get_key $key::Keys \
238		[::xmpp::jid::removeResource [connection_jid $xlib]]] eq ""} {
239	    chat::add_message $chatid $jid info \
240		      "[::msgcat::mc {OTR Info:}]\
241		       [::msgcat::mc {OTR is disabled because you have deleted your\
242				      OTR key. Generate or import a new one if you\
243				      want to enable it again.}]" {}
244	} else {
245	    chat::add_message $chatid $jid info \
246		      "[::msgcat::mc {OTR Info:}]\
247		       [::msgcat::mc {OTR conversation is lost because you have\
248				      changed your OTR key. The next private chat\
249				      will use the new key.}]" {}
250	}
251    }
252}
253
254proc otr::clear_all {xlib} {
255    variable ctx
256
257    foreach idx [array names ctx $xlib,*] {
258	regexp {[^,]*,(.*)} $idx -> jid
259	clear $xlib $jid
260    }
261}
262
263proc otr::clear_all_jid {myjid} {
264    foreach xlib [connections] {
265	if {[::xmpp::jid::equal $myjid \
266		[::xmpp::jid::removeResource [connection_jid $xlib]]]} {
267	    clear_all $xlib
268	}
269    }
270}
271
272proc otr::reset_auth {myjid} {
273    variable ctx
274
275    foreach xlib [connections] {
276	if {![::xmpp::jid::equal $myjid \
277		[::xmpp::jid::removeResource [connection_jid $xlib]]]} continue
278
279	foreach idx [array names ctx msgstate,$xlib,*] {
280	    regexp {msgstate,[^,]*,(.*)} $idx -> fjid
281	    on_msgstate_change $xlib $fjid $ctx($idx)
282	}
283    }
284
285}
286
287#############################################################################
288
289proc otr::on_authstate_change {xlib jid authstate} {
290    variable ctx
291
292    set ctx(authstate,$xlib,$jid) $authstate
293}
294
295proc otr::on_msgstate_change {xlib jid msgstate} {
296    variable ctx
297
298    set ctx(msgstate,$xlib,$jid) $msgstate
299}
300
301proc otr::on_smpstate_change {xlib jid smpstate} {
302    variable ctx
303
304    set ctx(smpstate,$xlib,$jid) $smpstate
305}
306
307#############################################################################
308
309proc otr::show_info {xlib jid info} {
310    set chatid [::chat::chatid $xlib $jid]
311    chat::add_message $chatid $jid info \
312		      "[::msgcat::mc {OTR Info:}] [::msgcat::mc $info]" {}
313}
314
315proc otr::show_error {xlib jid error} {
316    set chatid [::chat::chatid $xlib $jid]
317    chat::add_message $chatid $jid error \
318		      "[::msgcat::mc {OTR Error:}] $error" {}
319}
320
321proc otr::send {xlib jid message} {
322    upvar 2 type type
323
324    debugmsg otr "SEND: $xlib; $jid; $message;"
325
326    # Dirty hack to recover message type
327    for {set i 1} {$i < 12} {incr i} {
328	if {[catch {upvar $i type type}]} break
329	if {[info exists type] && $type eq "chat"} break
330    }
331
332    # Another dirty hack to translate OTR error messages
333    if {![catch {::otr::data::findErrorMessage $message} error]} {
334	set lang [get_jid_presence_info lang $xlib $jid]
335
336	set message [::otr::data::errorMessage [::trans::trans $lang $error]]
337    }
338
339    if {[info exists type] && $type eq "chat"} {
340	set targs [list -type $type]
341    } else {
342	set targs {}
343    }
344    ::xmpp::sendMessage $xlib $jid -body $message {*}$targs
345}
346
347#############################################################################
348
349proc otr::update_heartbeat {args} {
350    variable options
351    variable ctx
352
353    foreach idx [array names ctx ::*] {
354	::otr::configure $ctx($idx) -heartbeat $options(heartbeat-interval)
355    }
356}
357
358proc otr::get_policy {xlib jid} {
359    variable options
360    variable PolicyFlags
361
362    set njid [::xmpp::jid::normalize $jid]
363
364    set policy {}
365    foreach key {allow-encryption require-encryption
366		 send-whitespace-tag whitespace-or-error-start-ake} {
367	if {[info exists options($key,$xlib,$njid)]} {
368	    set flag $options($key,$xlib,$njid)
369	} else {
370	    set flag $options($key)
371	}
372	if {$flag} {
373	    lappend policy {*}$PolicyFlags($key)
374	}
375    }
376    debugmsg otr "GET_POLICY $xlib $jid $policy"
377    set policy
378}
379
380proc otr::update_default_policy {args} {
381    update_policy
382}
383
384proc otr::update_policy {{xlib ""} {jid ""}} {
385    variable ctx
386
387    if {$xlib eq ""} {
388	set xlibs [connections]
389    } else {
390	set xlibs [list $xlib]
391    }
392    foreach xl $xlibs {
393	if {$jid eq ""} {
394	    set jids {}
395	    foreach idx [array names ctx $xl,*] {
396		regexp "$xl,(.*)" $idx -> j
397		lappend jids $j
398	    }
399	} else {
400	    if {[info exists ctx($xl,$jid)]} {
401		set jids [list $jid]
402	    } else {
403		set jids {}
404	    }
405	}
406	foreach j $jids {
407	    ::otr::configure $ctx($xl,$j) -policy [get_policy $xl $j]
408	}
409    }
410}
411
412proc otr::reset_policy {xlib jid} {
413    variable options
414
415    set njid [::xmpp::jid::normalize $jid]
416
417    foreach key {allow-encryption require-encryption
418		 send-whitespace-tag whitespace-or-error-start-ake} {
419	if {[info exists options($key,$xlib,$njid)]} {
420	    unset options($key,$xlib,$njid)
421	}
422    }
423
424    update_policy $xlib $jid
425}
426
427#############################################################################
428
429proc otr::get_personal_prefs {xlib} {
430    variable options
431
432    set connjid [::xmpp::jid::normalize [connection_bare_jid $xlib]]
433    array set p $options(personal-preferences)
434
435    if {[info exists p($connjid)]} {
436	foreach {jid prefs} $p($connjid) {
437	    foreach {key val} $prefs {
438		set options($key,$xlib,$jid) $val
439	    }
440	}
441    }
442}
443
444hook::add connected_hook [namespace current]::otr::get_personal_prefs 1
445
446proc otr::set_personal_prefs {xlib} {
447    variable options
448
449    set connjid [::xmpp::jid::normalize [connection_bare_jid $xlib]]
450    array set p $options(personal-preferences)
451
452    set p($connjid) {}
453    set jids {}
454    foreach idx [array names options *,$xlib,*] {
455	lappend jids [join [lrange [split $idx ,] 2 end] ,]
456    }
457    set jids [lsort -unique $jids]
458
459    foreach j $jids {
460	set prefs {}
461	foreach key {allow-encryption require-encryption send-whitespace-tag
462		     whitespace-or-error-start-ake dont-log-otr-messages} {
463	    if {[info exists options($key,$xlib,$j)] && \
464		    $options($key,$xlib,$j) != $options($key)} {
465		lappend prefs $key $options($key,$xlib,$j)
466	    }
467	}
468	if {[llength $prefs] > 0} {
469	    lappend p($connjid) $j $prefs
470	}
471    }
472
473    if {[llength $p($connjid)] == 0} {
474	unset p($connjid)
475    }
476
477    set options(personal-preferences) [array get p]
478}
479
480hook::add disconnected_hook [namespace current]::otr::set_personal_prefs 40
481
482#############################################################################
483
484proc otr::request_session {xlib jid type} {
485    variable ctx
486
487    once_only $xlib $jid
488
489    set lang [get_jid_presence_info lang $xlib $jid]
490
491    ::otr::requestConversation $ctx($xlib,$jid) \
492	  \n[format [::trans::trans $lang \
493		    "%s has requested an Off-the-Record private conversation.\
494		    However, you do not have a plugin to support that.\nSee\
495		    http://otr.cypherpunks.ca/ for more information."] \
496		    [my_jid $xlib $jid]]]
497}
498
499proc otr::finish_session {xlib jid type} {
500    variable ctx
501
502    once_only $xlib $jid
503
504    ::otr::finishConversation $ctx($xlib,$jid)
505}
506
507proc otr::toggle_session {xlib jid type} {
508    if {[msgstate:index $xlib $jid] == 0} {
509	request_session $xlib $jid $type
510    } else {
511	finish_session $xlib $jid $type
512    }
513}
514
515#############################################################################
516
517proc otr::peer_jid {xlib jid} {
518    set bjid [::xmpp::jid::removeResource $jid]
519    if {![chat::is_groupchat [chat::chatid $xlib $bjid]]} {
520	return $bjid
521    } else {
522	return $jid
523    }
524}
525
526proc otr::begin_smp_dialog {xlib jid} {
527    variable ctx
528
529    set w .otrstartauth[jid_to_tag $jid]
530
531    Dialog $w -title [::msgcat::mc "Authenticate %s" [peer_jid $xlib $jid]] \
532	      -separator 1 -anchor e -default 0 -cancel 1
533
534    wm resizable $w 0 0
535
536    $w add -text [::msgcat::mc "Authenticate"] \
537	   -command [namespace code [list begin_smp $w $xlib $jid]]
538    $w add -text [::msgcat::mc "Cancel"] \
539	   -command [list destroy $w]
540
541    bind $w <Destroy> [namespace code [clear_dialog [double% $xlib] [double% $jid]]]
542    bind $w <<Copy>> [namespace code [add_to_clipboard [double% $xlib] [double% $jid]]]
543
544    set f [$w getframe]
545
546    set m [message $f.header -text [::msgcat::mc "Authenticate %s\n\nAuthenticating\
547					   a peer helps ensure that\
548					   the person you are talking to is who he\
549					   or she claims to be.\n\nHow would you\
550					   like to authenticate your peer?" \
551					   $jid] \
552			     -width 12c]
553    grid $m -row 1 -column 0 -sticky nswe
554    tk_optionMenu $f.choice [namespace current]::ctx(authmethod,$xlib,$jid) \
555			 [::msgcat::mc "Question and answer"] \
556			 [::msgcat::mc "Shared secret"] \
557			 [::msgcat::mc "Manual fingerprint verification"]
558    trace add variable [namespace current]::ctx(authmethod,$xlib,$jid) \
559	  write [namespace code [list smp_dialog_switch_page $w $xlib $jid]]
560
561    grid $f.choice -row 2 -column 0 -sticky nswe
562
563    set pm [PagesManager $f.method]
564    grid $pm -row 3 -column 0 -sticky nswe
565
566    $pm add qa
567    set pf1 [$pm getframe qa]
568    set m1 [message $pf1.instr -text [::msgcat::mc "To authenticate using a question,\
569					pick a question whose answer is known only to\
570					you and your peer. Enter this question and\
571					this answer, then wait for your peer to enter\
572					the answer too. If the answers don't match\
573					then you may be talking to an imposter."] \
574			      -width 12c]
575    grid $m1 -row 0 -column 0 -sticky nswe
576    set l1 [label $pf1.l1 -text [::msgcat::mc "Enter question here:"]]
577    grid $l1 -row 1 -column 0 -sticky nsw
578    set e1 [entry $pf1.e1]
579    grid $e1 -row 2 -column 0 -sticky nswe
580    set l2 [label $pf1.l2 -text [::msgcat::mc "Enter secret answer here (case sensitive):"]]
581    grid $l2 -row 3 -column 0 -sticky nsw
582    set e2 [entry $pf1.e2]
583    grid $e2 -row 4 -column 0 -sticky nswe
584    ProgressBar $pf1.pb -variable [namespace current]::ctx(progress,$xlib,$jid) -maximum 3
585    grid $pf1.pb -row 5 -column 0 -sticky ew
586    set l4 [label $pf1.l4 -textvariable [namespace current]::ctx(status,$xlib,$jid)]
587    grid $l4 -row 6 -column 0
588
589    $pm add ss
590    set pf2 [$pm getframe ss]
591    set m2 [message $pf2.instr -text [::msgcat::mc "To authenticate, pick a secret known\
592					only to you and your peer. Enter this secret,\
593					then wait for your peer to enter\
594					it too. If the secrets don't match\
595					then you may be talking to an imposter."] \
596			      -width 12c]
597    grid $m2 -row 0 -column 0 -sticky nswe
598    set l3 [label $pf2.l3 -text [::msgcat::mc "Enter secret here (case sensitive):"]]
599    grid $l3 -row 1 -column 0 -sticky nsw
600    set e3 [entry $pf2.e3]
601    grid $e3 -row 2 -column 0 -sticky nswe
602    ProgressBar $pf2.pb -variable [namespace current]::ctx(progress,$xlib,$jid) -maximum 3
603    grid $pf2.pb -row 3 -column 0 -sticky ew
604    set l4 [label $pf2.l4 -textvariable [namespace current]::ctx(status,$xlib,$jid)]
605    grid $l4 -row 4 -column 0
606
607    set ctx(progress,$xlib,$jid) 0
608    set ctx(status,$xlib,$jid) ""
609    set ctx(smpdialog,$xlib,$jid) $w
610
611    $pm add mfv
612    set pf3 [$pm getframe mfv]
613    set m3 [message $pf3.instr -text [::msgcat::mc "To verify the fingerprint, contact\
614					your peer via some other authenticated channel,\
615					such as the phone or GPG-signed email. Each of\
616					you should tell your fingerprint to the other.\
617					if everything matches up, you should indicate in\
618					this dialog that you have verified the\
619					fingerprint."] \
620			      -width 12c]
621    grid $m3 -row 0 -column 0 -columnspan 2 -sticky nswe
622    set m4 [message $pf3.mefp -text [::msgcat::mc "Fingerprint for you, %s:\n%s" \
623					    [connection_jid $xlib] \
624					    [::otr::fingerprint $ctx($xlib,$jid) 1]] \
625			      -width 12c]
626    grid $m4 -row 1 -column 0 -columnspan 2 -sticky nswe
627    set m5 [message $pf3.hefp -text [::msgcat::mc "Purported fingerprint for %s:\n%s" \
628					    $jid \
629					    [::otr::fingerprint $ctx($xlib,$jid) 0]] \
630			      -width 12c]
631    grid $m5 -row 2 -column 0 -columnspan 2 -sticky nswe
632    set myjid [::xmpp::jid::removeResource [connection_jid $xlib]]
633    set fingerprint [::otr::fingerprint $ctx($xlib,$jid)]
634    set tjid [peer_jid $xlib $jid]
635    if {![auth::get_auth $auth::Auth $myjid $tjid $fingerprint]} {
636	set ctx(ihave,$xlib,$jid) [::msgcat::mc "I have not verified"]
637    } else {
638	set ctx(ihave,$xlib,$jid) [::msgcat::mc "I have verified"]
639    }
640    tk_optionMenu $pf3.ihave [namespace current]::ctx(ihave,$xlib,$jid) \
641			 [::msgcat::mc "I have not verified"] \
642			 [::msgcat::mc "I have verified"]
643    grid $pf3.ihave -row 3 -column 0 -sticky nwe
644    set m6 [message $pf3.ver -text [::msgcat::mc "that this is in fact the\
645						  correct fingerprint for %s" \
646						  $jid] \
647			     -width 8c]
648    grid $pf3.ver -row 3 -column 1 -sticky nw
649    grid columnconfigure $pf3 0 -minsize 4c
650
651    $pm compute_size
652    $pm raise qa
653
654    $w draw
655}
656
657proc otr::clear_dialog {xlib jid} {
658    variable ctx
659
660    unset -nocomplain ctx(status,$xlib,$jid)
661    unset -nocomplain ctx(progress,$xlib,$jid)
662    unset -nocomplain ctx(authmethod,$xlib,$jid)
663    unset -nocomplain ctx(ihave,$xlib,$jid)
664    unset -nocomplain ctx(smpdialog,$xlib,$jid)
665}
666
667proc otr::add_to_clipboard {xlib jid} {
668    variable ctx
669
670    clipboard clear
671    if {![once_only $xlib $jid]} return
672
673    clipboard append [::otr::fingerprint $ctx($xlib,$jid) 1]
674    clipboard append \n
675    clipboard append [::otr::fingerprint $ctx($xlib,$jid) 0]
676}
677
678proc otr::smp_dialog_switch_page {w xlib jid name1 name2 op} {
679    variable ctx
680
681    set f [$w getframe]
682    set pm $f.method
683
684    if {$ctx(authmethod,$xlib,$jid) eq [::msgcat::mc "Question and answer"]} {
685	$pm raise qa
686    } elseif {$ctx(authmethod,$xlib,$jid) eq [::msgcat::mc "Shared secret"]} {
687	$pm raise ss
688    } else {
689	$pm raise mfv
690    }
691}
692
693proc otr::begin_smp {w xlib jid} {
694    variable ctx
695
696    if {$ctx(msgstate,$xlib,$jid) ne "MSGSTATE_ENCRYPTED"} {
697	MessageDlg .beginsmperr -aspect 50000 -icon error \
698	    -message [::msgcat::mc "You cannot verify the peer's identity using\
699				    SMP\nif an OTR session is not in progress"] \
700	    -type user -buttons ok -default 0 -cancel 0
701	return
702    }
703
704    if {$ctx(smpstate,$xlib,$jid) ne "SMPSTATE_EXPECT1"} {
705	MessageDlg .beginsmperr -aspect 50000 -icon error \
706	    -message [::msgcat::mc "SMP verification is in progress. If you want to\
707				    start new one, abort the current one first"] \
708	    -type user -buttons ok -default 0 -cancel 0
709	return
710    }
711
712    $w itemconfigure 0 -state disabled
713    $w itemconfigure 1 -command [namespace code [list abort_smp $w $xlib $jid]]
714
715    set f [$w getframe]
716    set pm $f.method
717
718    $f.choice configure -state disabled
719
720    set page [$pm raise]
721
722    set pf [$pm getframe $page]
723    switch -- $page {
724	qa  {
725	    $pf.e1 configure -state readonly
726	    $pf.e2 configure -state readonly
727	    set secret [$pf.e2 get]
728	    set question [list -question [$pf.e1 get]]
729	}
730	ss  {
731	    $pf.e3 configure -state readonly
732	    set secret [$pf.e3 get]
733	    set question {}
734	}
735	mfv {
736	    if {$ctx(ihave,$xlib,$jid) eq [::msgcat::mc "I have verified"]} {
737		set val 1
738	    } else {
739		set val 0
740	    }
741	    set myjid [::xmpp::jid::removeResource [connection_jid $xlib]]
742	    set fingerprint [::otr::fingerprint $ctx($xlib,$jid)]
743	    set tjid [peer_jid $xlib $jid]
744	    auth::set_auth auth::Auth $myjid $tjid $fingerprint $val
745	    auth::store $auth::Auth
746	    foreach idx [array names ctx msgstate,$xlib,*] {
747		regexp {msgstate,[^,]*,(.*)} $idx -> fjid
748		if {[peer_jid $xlib $fjid] eq $tjid} {
749		    on_msgstate_change $xlib $fjid $ctx($idx)
750		}
751	    }
752	    destroy $w
753	    return
754	}
755    }
756
757    ::otr::startSMP $ctx($xlib,$jid) $secret {*}$question
758}
759
760#############################################################################
761
762proc otr::reply_smp_dialog_qa {xlib jid question} {
763    variable ctx
764
765    set w .otrreplauth[jid_to_tag $jid]
766
767    Dialog $w -title [::msgcat::mc "Authentication from %s" [peer_jid $xlib $jid]] \
768	      -separator 1 -anchor e -default 0 -cancel 1
769
770    wm resizable $w 0 0
771
772    $w add -text [::msgcat::mc "Authenticate"] \
773	   -command [namespace code [list reply_smp $w $xlib $jid]]
774    $w add -text [::msgcat::mc "Cancel"] \
775	   -command [list destroy $w]
776
777    bind $w <Destroy> [namespace code [clear_dialog [double% $xlib] [double% $jid]]]
778
779    set f [$w getframe]
780
781    set m [message $f.header -text [::msgcat::mc "Authenticate %s\n\nAuthenticating\
782					   a peer helps ensure that\
783					   the person you are talking to is who he\
784					   or she claims to be." \
785					   $jid] \
786			     -width 12c]
787    grid $m -row 1 -column 0 -sticky nswe
788
789    set m1 [message $f.instr -text [::msgcat::mc "Your peer is attempting to determine\
790					if he or she is really talking to you, or if\
791					it's someone pretending to be you. Your peer\
792					has asked a question, indicated below. To\
793					authenticate to your peer, enter the answer\
794					and click 'Authenticate'."] \
795			      -width 12c]
796    grid $m1 -row 2 -column 0 -sticky nswe
797    set l1 [label $f.l1 -text [::msgcat::mc "This is the question asked by your peer:"]]
798    grid $l1 -row 3 -column 0 -sticky nsw
799    set m2 [message $f.m2 -text $question -width 12c]
800    grid $m2 -row 4 -column 0 -sticky nsw
801    set l2 [label $f.l2 -text [::msgcat::mc "Enter secret answer here (case sensitive):"]]
802    grid $l2 -row 5 -column 0 -sticky nsw
803    set e1 [entry $f.e1]
804    grid $e1 -row 6 -column 0 -sticky nswe
805    ProgressBar $f.pb -variable [namespace current]::ctx(progress,$xlib,$jid) -maximum 2
806    grid $f.pb -row 7 -column 0 -sticky ew
807    set l4 [label $f.l4 -textvariable [namespace current]::ctx(status,$xlib,$jid)]
808    grid $l4 -row 8 -column 0
809
810    set ctx(progress,$xlib,$jid) 0
811    set ctx(status,$xlib,$jid) ""
812    set ctx(smpdialog,$xlib,$jid) $w
813
814    $w draw
815}
816
817proc otr::reply_smp_dialog_ss {xlib jid} {
818    variable ctx
819
820    set w .otrreplauth[jid_to_tag $jid]
821
822    Dialog $w -title [::msgcat::mc "Authentication from %s" [peer_jid $xlib $jid]] \
823	      -separator 1 -anchor e -default 0 -cancel 1
824
825    wm resizable $w 0 0
826
827    $w add -text [::msgcat::mc "Authenticate"] \
828	   -command [namespace code [list reply_smp $w $xlib $jid]]
829    $w add -text [::msgcat::mc "Cancel"] \
830	   -command [list destroy $w]
831
832    bind $w <Destroy> [namespace code [clear_dialog [double% $xlib] [double% $jid]]]
833
834    set f [$w getframe]
835
836    set m [message $f.header -text [::msgcat::mc "Authenticate %s\n\nAuthenticating\
837					   a peer helps ensure that\
838					   the person you are talking to is who he\
839					   or she claims to be." \
840					   $jid] \
841			     -width 12c]
842    grid $m -row 1 -column 0 -sticky nswe
843
844    set m2 [message $f.instr -text [::msgcat::mc "Your peer is attempting to determine\
845					if he or she is really talking to you, or if\
846					it's someone pretending to be you. Your peer\
847					has picked a secret known only to him or her\
848					and you. To authenticate to your peer, enter\
849					this secret and click 'Authenticate'."] \
850			      -width 12c]
851    grid $m2 -row 2 -column 0 -sticky nswe
852    set l3 [label $f.l3 -text [::msgcat::mc "Enter secret here (case sensitive):"]]
853    grid $l3 -row 3 -column 0 -sticky nsw
854    set e1 [entry $f.e1]
855    grid $e1 -row 4 -column 0 -sticky nswe
856    ProgressBar $f.pb -variable [namespace current]::ctx(progress,$xlib,$jid) -maximum 2
857    grid $f.pb -row 5 -column 0 -sticky ew
858    set l4 [label $f.l4 -textvariable [namespace current]::ctx(status,$xlib,$jid)]
859    grid $l4 -row 6 -column 0
860
861    set ctx(status,$xlib,$jid) ""
862    set ctx(progress,$xlib,$jid) 0
863    set ctx(smpdialog,$xlib,$jid) $w
864
865    $w draw
866}
867
868proc otr::reply_smp {w xlib jid} {
869    variable ctx
870
871    if {$ctx(msgstate,$xlib,$jid) ne "MSGSTATE_ENCRYPTED"} {
872	MessageDlg .beginsmperr -aspect 50000 -icon error \
873	    -message [::msgcat::mc "You cannot verify the peer's identity using\
874				    SMP\nif an OTR session is not in progress"] \
875	    -type user -buttons ok -default 0 -cancel 0
876	return
877    }
878
879    if {$ctx(smpstate,$xlib,$jid) ne "SMPSTATE_EXPECT1"} {
880	MessageDlg .beginsmperr -aspect 50000 -icon error \
881	    -message [::msgcat::mc "SMP verification is in progress. If you want to\
882				    start new one, abort the current one first"] \
883	    -type user -buttons ok -default 0 -cancel 0
884	return
885    }
886
887    $w itemconfigure 0 -state disabled
888    $w itemconfigure 1 -command [namespace code [list abort_smp $w $xlib $jid]]
889
890    set f [$w getframe]
891    $f.e1 configure -state readonly
892    set secret [$f.e1 get]
893
894    ::otr::replySMP $ctx($xlib,$jid) $secret
895}
896
897proc otr::abort_smp {w xlib jid} {
898    variable ctx
899
900    ::otr::abortSMP $ctx($xlib,$jid)
901
902    destroy $w
903}
904
905proc otr::result_smp {w xlib jid} {
906    if {![winfo exists $w]} return
907
908    $w itemconfigure 0 -state normal -text [::msgcat::mc "OK"] -command [list destroy $w]
909    $w itemconfigure 1 -state disabled -command [list destroy $w]
910}
911
912proc otr::progress_smp {xlib jid progress} {
913    variable ctx
914
915    if {![info exists ctx(smpdialog,$xlib,$jid)]} return
916
917    set w $ctx(smpdialog,$xlib,$jid)
918
919    switch -- $progress {
920	SMP_PROGRESS {
921	    incr ctx(progress,$xlib,$jid)
922	}
923	SMP_ABORT {
924	    set ctx(progress,$xlib,$jid) 3
925	    set ctx(status,$xlib,$jid) [::msgcat::mc "Authentication aborted"]
926	    result_smp $w $xlib $jid
927	}
928	SMP_CHEATING {
929	    set ctx(progress,$xlib,$jid) 3
930	    set ctx(status,$xlib,$jid) [::msgcat::mc "Protocol error"]
931	    result_smp $w $xlib $jid
932	}
933	SMP_SUCCESS {
934	    set ctx(progress,$xlib,$jid) 3
935	    set ctx(status,$xlib,$jid) [::msgcat::mc "Authentication succeeded"]
936	    result_smp $w $xlib $jid
937
938	    set myjid [::xmpp::jid::removeResource [connection_jid $xlib]]
939	    set fingerprint [::otr::fingerprint $ctx($xlib,$jid)]
940	    set tjid [peer_jid $xlib $jid]
941	    auth::set_auth auth::Auth $myjid $tjid $fingerprint 1
942	    auth::store $auth::Auth
943	    foreach idx [array names ctx msgstate,$xlib,*] {
944		regexp {msgstate,[^,]*,(.*)} $idx -> fjid
945		if {[peer_jid $xlib $fjid] eq $tjid} {
946		    on_msgstate_change $xlib $fjid $ctx($idx)
947		}
948	    }
949	}
950	SMP_FAILURE {
951	    set ctx(progress,$xlib,$jid) 3
952	    set ctx(status,$xlib,$jid) [::msgcat::mc "Authentication failed"]
953	    result_smp $w $xlib $jid
954
955	    set myjid [::xmpp::jid::removeResource [connection_jid $xlib]]
956	    set fingerprint [::otr::fingerprint $ctx($xlib,$jid)]
957	    set tjid [peer_jid $xlib $jid]
958	    auth::set_auth auth::Auth $myjid $tjid $fingerprint 0
959	    auth::store $auth::Auth
960	    foreach idx [array names ctx msgstate,$xlib,*] {
961		regexp {msgstate,[^,]*,(.*)} $idx -> fjid
962		if {[peer_jid $xlib $fjid] eq $tjid} {
963		    on_msgstate_change $xlib $fjid $ctx($idx)
964		}
965	    }
966	}
967    }
968}
969
970#############################################################################
971
972proc otr::rewrite_message_body \
973     {vxlib vfrom vid vtype vis_subject vsubject vbody verr vthread vpriority vx} {
974    upvar 2 $vxlib xlib
975    upvar 2 $vfrom from
976    upvar 2 $vtype type
977    upvar 2 $vbody body
978    upvar 2 $verr err
979    upvar 2 $vx x
980    variable ns
981    variable ctx
982
983    # Work only in chats and normal messages
984    if {$type ne "" && $type ne "normal" && $type ne "chat"} return
985
986    # We can't distinguish between bodyless message and message with empty
987    # body, so be it
988    if {$body eq ""} return
989
990    if {![once_only $xlib $from]} return
991
992    set result [::otr::incomingMessage $ctx($xlib,$from) $body]
993
994    debugmsg otr "INCOMING MESSAGE: $xlib; $from; $result;"
995
996    array set res $result
997
998    if {[info exists res(message)]} {
999	set body $res(message)
1000	if {[info exists res(warn)]} {
1001	    lappend x [::xmpp::xml::create "" \
1002				-xmlns $ns \
1003				-attrs {icon otr/notprivate}]
1004	} elseif {[msgstate:index $xlib $from] != 0} {
1005	    lappend x [::xmpp::xml::create "" \
1006				-xmlns $ns \
1007				-attrs [list icon [msgstate:icon $xlib $from]]]
1008	}
1009    } else {
1010	lappend x [::xmpp::xml::create "" -xmlns $ns -attrs {discard 1}]
1011    }
1012
1013    if {[info exists res(question)]} {
1014	after idle [namespace code [list reply_smp_dialog_qa \
1015					 $xlib $from $res(question)]]
1016    }
1017
1018    if {[info exists res(secret)]} {
1019	after idle [namespace code [list reply_smp_dialog_ss \
1020					 $xlib $from]]
1021    }
1022    return
1023}
1024
1025hook::add rewrite_message_hook [namespace current]::otr::rewrite_message_body 80
1026
1027###############################################################################
1028
1029proc otr::discard_message {xlib from id type is_subject \
1030			   subject body err thread priority x} {
1031    variable ns
1032
1033    foreach xel $x {
1034	::xmpp::xml::split $xel tag xmlns attrs cdata subels
1035
1036	if {$tag eq "" && $xmlns eq $ns && \
1037		[::xmpp::xml::getAttr $attrs discard] == 1} {
1038	    return -code break
1039	}
1040    }
1041    return
1042}
1043
1044hook::add process_message_hook [namespace current]::otr::discard_message 0.1
1045
1046###############################################################################
1047
1048proc otr::rewrite_outgoing_message_body \
1049     {vxlib vto vid vtype vsubject vbody verr vthread vx} {
1050    upvar 2 $vxlib xlib
1051    upvar 2 $vto to
1052    upvar 2 $vtype type
1053    upvar 2 $vbody body
1054    upvar 2 $vx x
1055    variable ctx
1056
1057    # Only chat and normal messages are subject to OTR
1058    if {[info exists type] &&
1059	$type ne "" && $type ne "normal" && $type ne "chat"} return
1060
1061    # Only messages with body are subject to OTR
1062    if {![info exists body]} return
1063
1064    if {![once_only $xlib $to]} return
1065
1066    # Only the message body is encrypted if appropriate
1067    set result [::otr::outgoingMessage $ctx($xlib,$to) $body]
1068
1069    debugmsg otr "OUTGOING MESSAGE: $xlib; $to; $result;"
1070
1071    array set res $result
1072
1073    if {[info exists res(message)]} {
1074	set body $res(message)
1075	if {$type eq "chat" && [msgstate:index $xlib $to] > 0} {
1076	    set chatid [chat::chatid $xlib $to]
1077	    set chatw [chat::chat_win $chatid]
1078	    if {[winfo exists $chatw]} {
1079		$chatw image create end -image [msgstate:icon $xlib $to]
1080	    }
1081	}
1082    } else {
1083	# Disable sending
1084	hook::unset_flag rewrite_outgoing_message_hook send
1085
1086	# Don't show this message in the chat log window
1087	# This flag makes sense only for chat messages, but causes no harm for
1088	# normal ones
1089	hook::unset_flag chat_send_message_hook draw
1090    }
1091    return
1092}
1093
1094hook::add rewrite_outgoing_message_hook \
1095	  [namespace current]::otr::rewrite_outgoing_message_body 10
1096
1097###############################################################################
1098
1099proc otr::disable_log {chatid from type body x} {
1100    set xlib [chat::get_xlib $chatid]
1101    set jid [chat::get_jid $chatid]
1102
1103    if {[log_is_disabled $xlib $jid]} {
1104	hook::unset_flag draw_message_hook log
1105    }
1106    return
1107}
1108
1109hook::add draw_message_hook [namespace current]::otr::disable_log 10
1110
1111proc otr::disable_archive_in {xlib from id type is_subject subject body err thread priority x} {
1112    if {[log_is_disabled $xlib $from]} {
1113	hook::unset_flag process_message_hook log
1114    }
1115    return
1116}
1117
1118hook::add process_message_hook [namespace current]::otr::disable_archive_in 10
1119
1120proc otr::disable_archive_out {xlib to subject body thread} {
1121    if {[log_is_disabled $xlib $to]} {
1122	hook::unset_flag send_normal_message_hook log
1123    }
1124    return
1125}
1126
1127hook::add send_normal_message_hook [namespace current]::otr::disable_archive_out 10
1128
1129proc otr::log_is_disabled {xlib jid} {
1130    variable options
1131    variable ctx
1132
1133    if {![info exists ctx($xlib,$jid)]} {
1134	return 0
1135    }
1136
1137    set njid [::xmpp::jid::normalize $jid]
1138
1139    switch -- $ctx(msgstate,$xlib,$jid) {
1140	MSGSTATE_ENCRYPTED {
1141	    if {[info exists options(dont-log-otr-messages,$xlib,$njid)]} {
1142		return $options(dont-log-otr-messages,$xlib,$njid)
1143	    } else {
1144		return $options(dont-log-otr-messages)
1145	    }
1146	}
1147    }
1148    return 0
1149}
1150
1151#############################################################################
1152
1153proc otr::msgstate:trace {script xlib jid} {
1154    variable trace
1155
1156    if {![info exists trace(msgstate,$xlib,$jid)]} {
1157        set trace(msgstate,$xlib,$jid) {}
1158    }
1159
1160    if {[list write [namespace current]::trace] ni
1161	    [trace info variable [namespace current]::ctx(msgstate,$xlib,$jid)]} {
1162        trace add variable [namespace current]::ctx(msgstate,$xlib,$jid) write \
1163			   [namespace current]::tracevar
1164    }
1165
1166    if {$script ne {} && ($script ni $trace(msgstate,$xlib,$jid))} {
1167	lappend trace(msgstate,$xlib,$jid) $script
1168    }
1169}
1170
1171proc otr::tracevar {name1 name2 op} {
1172    variable trace
1173
1174    set new {}
1175    foreach script $trace($name2) {
1176        if {[catch { {*}$script } result]} {
1177            debugmsg otr "$result -- $script"
1178        } else {
1179            lappend new $script
1180        }
1181    }
1182    set trace($name2) $new
1183}
1184
1185#############################################################################
1186
1187proc otr::message_button {mw xlib jid} {
1188    set bbox [ButtonBox $mw.bottom.otrbutton -spacing 0]
1189
1190    set b [$bbox add \
1191		 -image [msgstate:icon $xlib $jid] \
1192		 -helptype balloon \
1193		 -helptext [msgstate:helptext $xlib $jid] \
1194		 -height 24 \
1195		 -width 24 \
1196		 -relief link \
1197		 -bd $::tk_borderwidth \
1198		 -state [msgstate:enabled $xlib $jid] \
1199		 -command [namespace code [list toggle_session $xlib $jid ""]]]
1200
1201    msgstate:trace [list [namespace current]::msgstate:button_conf $b $xlib $jid] \
1202		   $xlib $jid
1203
1204    pack $bbox -side left -fill x -padx 2m -pady 2m
1205}
1206
1207hook::add open_message_post_hook [namespace current]::otr::message_button 55
1208
1209###############################################################################
1210
1211proc otr::chat_window_button {chatid type} {
1212    if {$type ne "chat"} {
1213	return
1214    }
1215
1216    set xlib [chat::get_xlib $chatid]
1217    set jid [chat::get_jid $chatid]
1218    set cw [chat::winid $chatid]
1219
1220    set b [Button $cw.status.otrmsgstate \
1221		  -relief flat \
1222		  -image [msgstate:icon $xlib $jid] \
1223		  -helptype balloon \
1224		  -helptext [msgstate:helptext $xlib $jid] \
1225		  -state [msgstate:enabled $xlib $jid] \
1226		  -command [namespace code [list toggle_session $xlib $jid $type]]]
1227
1228    msgstate:trace [list [namespace current]::msgstate:button_conf $b $xlib $jid] \
1229		   $xlib $jid
1230
1231    pack $b -side left -before $cw.status.mb
1232}
1233
1234hook::add open_chat_post_hook [namespace current]::otr::chat_window_button 55
1235
1236#############################################################################
1237
1238proc otr::msgstate:button_conf {b xlib jid} {
1239    $b configure -image [msgstate:icon $xlib $jid] \
1240		 -helptext [msgstate:helptext $xlib $jid] \
1241		 -state [msgstate:enabled $xlib $jid]
1242}
1243
1244proc otr::msgstate:icon {xlib jid} {
1245    lindex [list otr/notprivate \
1246		 otr/unverified \
1247		 otr/private \
1248		 otr/finished] \
1249           [msgstate:index $xlib $jid]
1250}
1251
1252proc otr::msgstate:helptext {xlib jid} {
1253    variable ctx
1254
1255    set text [::msgcat::mc "State:"]
1256    append text " " [msgstate:state $xlib $jid]
1257    switch -- [msgstate:index $xlib $jid] {
1258	1 - 2 {
1259	    append text \n [::msgcat::mc "Fingerprint:"] " " \
1260			[::otr::fingerprint $ctx($xlib,$jid)] \
1261			\n [::msgcat::mc "SSID:"] " " \
1262			[::otr::ssid $ctx($xlib,$jid)]
1263	}
1264    }
1265    set text
1266}
1267
1268proc otr::msgstate:state {xlib jid} {
1269    lindex [list [::msgcat::mc "Not private"] \
1270		 [::msgcat::mc "Unverified"] \
1271		 [::msgcat::mc "Private"] \
1272		 [::msgcat::mc "Finished"]] \
1273           [msgstate:index $xlib $jid]
1274}
1275
1276proc otr::msgstate:index {xlib jid} {
1277    variable ctx
1278
1279    if {[info exists ctx($xlib,$jid)]} {
1280	switch -- $ctx(msgstate,$xlib,$jid) {
1281	    MSGSTATE_PLAINTEXT {
1282		return 0
1283	    }
1284	    MSGSTATE_ENCRYPTED {
1285		set myjid [::xmpp::jid::removeResource [connection_jid $xlib]]
1286		set fingerprint [::otr::fingerprint $ctx($xlib,$jid)]
1287		set tjid [peer_jid $xlib $jid]
1288		if {![auth::get_auth $auth::Auth $myjid $tjid $fingerprint]} {
1289		    return 1
1290		} else {
1291		    return 2
1292		}
1293	    }
1294	    MSGSTATE_FINISHED {
1295		return 3
1296	    }
1297	}
1298    }
1299    return 0
1300}
1301
1302proc otr::msgstate:enabled {xlib jid} {
1303    if {[lsearch -exact [connections] $xlib] < 0
1304	    || [::xmpp::jid::equal [my_jid $xlib $jid] $jid]
1305	    || ![once_only $xlib $jid]} {
1306	return disabled
1307    } else {
1308	return normal
1309    }
1310}
1311
1312###############################################################################
1313
1314proc otr::enable_disable_buttons {xlib} {
1315    variable ctx
1316
1317    foreach chatid [chat::opened $xlib] {
1318	set jid [chat::get_jid $chatid]
1319	if {[info exists ctx(msgstate,$xlib,$jid)]} {
1320	    on_msgstate_change $xlib $jid $ctx(msgstate,$xlib,$jid)
1321	} else {
1322	    on_msgstate_change $xlib $jid MSGSTATE_PLAINTEXT
1323	}
1324    }
1325}
1326
1327hook::add connected_hook [namespace current]::otr::enable_disable_buttons
1328hook::add disconnected_hook [namespace current]::otr::enable_disable_buttons
1329
1330###############################################################################
1331
1332proc otr::user_popup_info {infovar xlib jid} {
1333    variable ctx
1334
1335    upvar 0 $infovar info
1336
1337    if {[info exists ctx($xlib,$jid)]} {
1338	append info [::msgcat::mc "\n\tOTR:"]
1339	append info [regsub -all {\n} \n[msgstate:helptext $xlib $jid] "\n\t    "]
1340    }
1341}
1342
1343hook::add roster_user_popup_info_hook [namespace current]::otr::user_popup_info 99
1344
1345#############################################################################
1346
1347proc otr::userinfo {tab xlib jid editable} {
1348    variable ctx
1349
1350    if {$editable} return
1351
1352    set bjid [::xmpp::jid::removeResource $jid]
1353    set chatid [chat::chatid $xlib $bjid]
1354    if {[chat::is_groupchat $chatid]} {
1355	if {[info exists ctx(authstate,$xlib,$jid)]} {
1356	    set jids [list authstate,$xlib,$jid]
1357	} else {
1358	    set jids [list]
1359	}
1360    } else {
1361	set bjpat [regsub -all {(.)} $bjid {\\\1}]
1362	set jids [array names ctx authstate,$xlib,$bjpat/*]
1363    }
1364    if {[llength $jids] > 0} {
1365	set otrinfo [$tab insert end otrinfo \
1366			      -text [::msgcat::mc "OTR"]]
1367
1368	set sw [ScrolledWindow $otrinfo.sw -scrollbar vertical]
1369	pack $sw -fill both -expand yes
1370	set sf [ScrollableFrame $otrinfo.sf -constrainedwidth 1]
1371	$sw setwidget $sf
1372
1373	set i 0
1374	foreach j $jids {
1375	    regexp {authstate,[^,]*,(.*)} $j -> fjid
1376	    set x [userinfo::pack_frame [$sf getframe].otr_$i $fjid]
1377
1378	    userinfo::pack_entry $jid $x 1 otr_state_$i [::msgcat::mc "State:"]
1379	    set userinfo::userinfo(otr_state_$i,$jid) [msgstate:state $xlib $fjid]
1380
1381	    userinfo::pack_entry $jid $x 2 otr_fingerprint_$i [::msgcat::mc "Fingerprint:"]
1382	    set userinfo::userinfo(otr_fingerprint_$i,$jid) [::otr::fingerprint $ctx($xlib,$fjid)]
1383
1384	    userinfo::pack_entry $jid $x 3 otr_ssid_$i [::msgcat::mc "SSID:"]
1385	    set userinfo::userinfo(otr_ssid_$i,$jid) [::otr::ssid $ctx($xlib,$fjid)]
1386
1387	    bindscrolldeep $sf $sf
1388	    incr i
1389	}
1390    }
1391}
1392
1393hook::add userinfo_hook [namespace current]::otr::userinfo 90
1394
1395proc otr::bindscrolldeep {w f} {
1396    bindscroll $w $f
1397    foreach sw [winfo children $w] {
1398	bindscrolldeep $sw $f
1399    }
1400}
1401
1402###############################################################################
1403
1404proc otr::main_menu {} {
1405    variable options
1406
1407    catch {
1408	set m [.mainframe getmenu tkabber]
1409	set ind [$m index [::msgcat::mc "View"]]
1410	incr ind -1
1411
1412	set mm .otr_menu
1413	menu $mm -tearoff $::ifacetk::options(show_tearoffs)
1414	$mm add command -label [::msgcat::mc "Manage private keys"] \
1415	    -command [namespace code key::manage_keys_dialog]
1416	$mm add command -label [::msgcat::mc "Edit authentication"] \
1417	    -command [namespace code auth::edit_auth_dialog]
1418	$mm add separator
1419	$mm add checkbutton -label [::msgcat::mc "Allow encryption"] \
1420	    -variable [namespace current]::options(allow-encryption)
1421	$mm add checkbutton -label [::msgcat::mc "Require encryption"] \
1422	    -variable [namespace current]::options(require-encryption)
1423	$mm add checkbutton -label [::msgcat::mc "Attach whitespace tag"] \
1424	    -variable [namespace current]::options(send-whitespace-tag)
1425	$mm add checkbutton -label [::msgcat::mc "Start AKE on whitespace tag or OTR error"] \
1426	    -variable [namespace current]::options(whitespace-or-error-start-ake)
1427	$mm add checkbutton -label [::msgcat::mc "Don't log OTR messages"] \
1428	    -variable [namespace current]::options(dont-log-otr-messages)
1429
1430	$m insert $ind cascade -label [::msgcat::mc "OTR"] \
1431	    -menu $mm
1432    }
1433}
1434
1435hook::add finload_hook [namespace current]::otr::main_menu 55
1436
1437###############################################################################
1438
1439proc otr::user_menu {type m xlib jid} {
1440    variable options
1441    variable ctx
1442
1443    set njid [::xmpp::jid::normalize $jid]
1444
1445    foreach key {allow-encryption require-encryption send-whitespace-tag
1446		 whitespace-or-error-start-ake dont-log-otr-messages} {
1447	if {![info exists options($key,$xlib,$njid)]} {
1448	    set options($key,$xlib,$njid) $options($key)
1449	}
1450    }
1451
1452    if {[::xmpp::jid::equal [my_jid $xlib $jid] $jid] || ![once_only $xlib $jid]} {
1453	set state disabled
1454	set qstate disabled
1455	set rstate disabled
1456	set fstate disabled
1457	set astate disabled
1458    } else {
1459	switch -- $ctx(msgstate,$xlib,$jid) {
1460	    MSGSTATE_PLAINTEXT {
1461		set qstate normal
1462		set rstate disabled
1463		set fstate disabled
1464		set astate disabled
1465	    }
1466	    MSGSTATE_ENCRYPTED {
1467		set qstate disabled
1468		set rstate normal
1469		set fstate normal
1470		set astate normal
1471	    }
1472	    MSGSTATE_FINISHED {
1473		set qstate disabled
1474		set rstate normal
1475		set fstate normal
1476		set astate disabled
1477	    }
1478	}
1479    }
1480
1481    if {![info exists state] && [lsearch -exact [connections] $xlib] >= 0} {
1482	set state normal
1483    } else {
1484	set state disabled
1485    }
1486
1487    set mm $m.otr_menu
1488    menu $mm -tearoff 0
1489    $mm add command -label [::msgcat::mc "Start OTR session"] \
1490	-command [list [namespace current]::request_session $xlib $jid $type] \
1491	-state $qstate
1492    $mm add command -label [::msgcat::mc "Refresh OTR session"] \
1493	-command [list [namespace current]::request_session $xlib $jid $type] \
1494	-state $rstate
1495    $mm add command -label [::msgcat::mc "End OTR session"] \
1496	-command [list [namespace current]::finish_session $xlib $jid $type] \
1497	-state $fstate
1498    $mm add separator
1499    $mm add command -label [::msgcat::mc "Authenticate peer..."] \
1500	-command [list [namespace current]::begin_smp_dialog $xlib $jid] \
1501	-state $astate
1502    $mm add separator
1503    $mm add command -label [::msgcat::mc "Reset to default policy"] \
1504	-command [list [namespace current]::reset_policy $xlib $jid]
1505    $mm add checkbutton -label [::msgcat::mc "Allow encryption"] \
1506	-variable [namespace current]::options(allow-encryption,$xlib,$njid) \
1507	-command [list [namespace current]::update_policy $xlib $jid]
1508    $mm add checkbutton -label [::msgcat::mc "Require encryption"] \
1509	-variable [namespace current]::options(require-encryption,$xlib,$njid) \
1510	-command [list [namespace current]::update_policy $xlib $jid]
1511    $mm add checkbutton -label [::msgcat::mc "Attach whitespace tag"] \
1512	-variable [namespace current]::options(send-whitespace-tag,$xlib,$njid) \
1513	-command [list [namespace current]::update_policy $xlib $jid]
1514    $mm add checkbutton -label [::msgcat::mc "Start AKE on whitespace tag or OTR error"] \
1515	-variable [namespace current]::options(whitespace-or-error-start-ake,$xlib,$njid) \
1516	-command [list [namespace current]::update_policy $xlib $jid]
1517    $mm add checkbutton -label [::msgcat::mc "Don't log OTR messages"] \
1518	-variable [namespace current]::options(dont-log-otr-messages,$xlib,$njid) \
1519	-command [list [namespace current]::update_policy $xlib $jid]
1520
1521    $m add cascade -label [::msgcat::mc "OTR"] -menu $mm -state $state
1522}
1523
1524hook::add chat_create_user_menu_hook [list [namespace current]::otr::user_menu chat] 43.8
1525hook::add roster_jid_popup_menu_hook [list [namespace current]::otr::user_menu ""] 43.8
1526hook::add message_dialog_menu_hook [list [namespace current]::otr::user_menu ""] 43.8
1527hook::add roster_create_groupchat_user_menu_hook [list [namespace current]::otr::user_menu ""] 43.8
1528
1529###############################################################################
1530
1531# vim:ts=8:sw=4:sts=4:noet
1532