http-push: fix off-by-path_len
[git/platforms.git] / git-gui / lib / sshkey.tcl
blob82a1a80ff4cf4e9f89d916c3052d731637acb6c9
1 # git-gui about git-gui dialog
2 # Copyright (C) 2006, 2007 Shawn Pearce
4 proc find_ssh_key {} {
5 foreach name {~/.ssh/id_dsa.pub ~/.ssh/id_rsa.pub ~/.ssh/identity.pub} {
6 if {[file exists $name]} {
7 set fh [open $name r]
8 set cont [read $fh]
9 close $fh
10 return [list $name $cont]
14 return {}
17 proc do_ssh_key {} {
18 global sshkey_title have_tk85 sshkey_fd
20 set w .sshkey_dialog
21 if {[winfo exists $w]} {
22 raise $w
23 return
26 toplevel $w
27 wm transient $w .
29 set finfo [find_ssh_key]
30 if {$finfo eq {}} {
31 set sshkey_title [mc "No keys found."]
32 set gen_state normal
33 } else {
34 set sshkey_title [mc "Found a public key in: %s" [lindex $finfo 0]]
35 set gen_state disabled
38 frame $w.header -relief flat
39 label $w.header.lbl -textvariable sshkey_title -anchor w
40 button $w.header.gen -text [mc "Generate Key"] \
41 -command [list make_ssh_key $w] -state $gen_state
42 pack $w.header.lbl -side left -expand 1 -fill x
43 pack $w.header.gen -side right
44 pack $w.header -fill x -pady 5 -padx 5
46 text $w.contents -width 60 -height 10 -wrap char -relief sunken
47 pack $w.contents -fill both -expand 1
48 if {$have_tk85} {
49 $w.contents configure -inactiveselectbackground darkblue
52 frame $w.buttons
53 button $w.buttons.close -text [mc Close] \
54 -default active -command [list destroy $w]
55 pack $w.buttons.close -side right
56 button $w.buttons.copy -text [mc "Copy To Clipboard"] \
57 -command [list tk_textCopy $w.contents]
58 pack $w.buttons.copy -side left
59 pack $w.buttons -side bottom -fill x -pady 5 -padx 5
61 if {$finfo ne {}} {
62 $w.contents insert end [lindex $finfo 1] sel
64 $w.contents configure -state disabled
66 bind $w <Visibility> "grab $w; focus $w.buttons.close"
67 bind $w <Key-Escape> "destroy $w"
68 bind $w <Key-Return> "destroy $w"
69 bind $w <Destroy> kill_sshkey
70 wm title $w [mc "Your OpenSSH Public Key"]
71 tk::PlaceWindow $w widget .
72 tkwait window $w
75 proc make_ssh_key {w} {
76 global sshkey_title sshkey_output sshkey_fd
78 set sshkey_title [mc "Generating..."]
79 $w.header.gen configure -state disabled
81 set cmdline [list sh -c {echo | ssh-keygen -q -t rsa -f ~/.ssh/id_rsa 2>&1}]
83 if {[catch { set sshkey_fd [_open_stdout_stderr $cmdline] } err]} {
84 error_popup [mc "Could not start ssh-keygen:\n\n%s" $err]
85 return
88 set sshkey_output {}
89 fconfigure $sshkey_fd -blocking 0
90 fileevent $sshkey_fd readable [list read_sshkey_output $sshkey_fd $w]
93 proc kill_sshkey {} {
94 global sshkey_fd
95 if {![info exists sshkey_fd]} return
96 catch { kill_file_process $sshkey_fd }
97 catch { close $sshkey_fd }
100 proc read_sshkey_output {fd w} {
101 global sshkey_fd sshkey_output sshkey_title
103 set sshkey_output "$sshkey_output[read $fd]"
104 if {![eof $fd]} return
106 fconfigure $fd -blocking 1
107 unset sshkey_fd
109 $w.contents configure -state normal
110 if {[catch {close $fd} err]} {
111 set sshkey_title [mc "Generation failed."]
112 $w.contents insert end $err
113 $w.contents insert end "\n"
114 $w.contents insert end $sshkey_output
115 } else {
116 set finfo [find_ssh_key]
117 if {$finfo eq {}} {
118 set sshkey_title [mc "Generation succeded, but no keys found."]
119 $w.contents insert end $sshkey_output
120 } else {
121 set sshkey_title [mc "Your key is in: %s" [lindex $finfo 0]]
122 $w.contents insert end [lindex $finfo 1] sel
125 $w.contents configure -state disable