|
0
|
1 |
#!/usr/bin/wish
|
|
3
|
2 |
# encoding: utf-8
|
|
|
3 |
#
|
|
|
4 |
# Tkccrypt - a frontend for Peter Selinger's ccrypt
|
|
|
5 |
# Copyright (C) 2006 Lluís Batlle i Rossell
|
|
|
6 |
#
|
|
|
7 |
# This program is free software; you can redistribute it and/or
|
|
|
8 |
# modify it under the terms of the GNU General Public License
|
|
|
9 |
# as published by the Free Software Foundation; either version 2
|
|
|
10 |
# of the License, or (at your option) any later version.
|
|
|
11 |
#
|
|
|
12 |
# This program is distributed in the hope that it will be useful,
|
|
|
13 |
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
14 |
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
15 |
# GNU General Public License for more details.
|
|
|
16 |
#
|
|
|
17 |
# You should have received a copy of the GNU General Public License
|
|
|
18 |
# along with this program; if not, write to the Free Software
|
|
|
19 |
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
|
|
20 |
#
|
|
0
|
21 |
|
|
|
22 |
text .text -relief sunken -bd 2 -yscrollcommand ".scroll set" -setgrid 1 \
|
|
|
23 |
-height 30 -undo 1 -autosep 1
|
|
|
24 |
scrollbar .scroll -command ".text yview"
|
|
|
25 |
pack .scroll -side right -fill y
|
|
|
26 |
pack .text -expand yes -fill both
|
|
|
27 |
|
|
|
28 |
menu .menu -tearoff 0
|
|
|
29 |
|
|
|
30 |
set File .menu.file
|
|
2
|
31 |
|
|
|
32 |
set filetypes {
|
|
|
33 |
{"CCrypt files" { ".cpt" } { "CPT "}}
|
|
|
34 |
}
|
|
|
35 |
|
|
0
|
36 |
menu $File -tearoff 0
|
|
|
37 |
.menu add cascade -label "File" -menu $File
|
|
|
38 |
$File add command -label "New" -command { newfile }
|
|
|
39 |
$File add command -label "Open" -command { openfile }
|
|
|
40 |
$File add command -label "Save" -command { savefile $actualfile $actualpass}
|
|
|
41 |
$File add command -label "Save as..." -command { savefile }
|
|
|
42 |
$File add separator
|
|
|
43 |
$File add command -label "Quit" -command { exit}
|
|
|
44 |
|
|
|
45 |
. configure -menu .menu
|
|
|
46 |
|
|
|
47 |
set actualpass ""
|
|
|
48 |
set actualfile ""
|
|
3
|
49 |
wm title . "tkccrypt - New File"
|
|
0
|
50 |
|
|
|
51 |
proc askpassword { op entries } {
|
|
|
52 |
set tl [toplevel .pass]
|
|
|
53 |
global password1 password2
|
|
|
54 |
global actualpass
|
|
|
55 |
|
|
|
56 |
set password1 ""
|
|
|
57 |
set password2 ""
|
|
2
|
58 |
label .pass.info -text "Please introduce your password for $op:"
|
|
0
|
59 |
pack .pass.info -side top
|
|
|
60 |
|
|
|
61 |
entry .pass.entry -textvariable password1 -show "*"
|
|
|
62 |
pack .pass.entry -side top
|
|
2
|
63 |
bind .pass.entry <Return> {destroy .pass}
|
|
0
|
64 |
if { $entries == 2} {
|
|
2
|
65 |
label .pass.info2 -text "2nd time, for verification:"
|
|
|
66 |
pack .pass.info2 -side top
|
|
0
|
67 |
entry .pass.entry2 -textvariable password2 -show "*"
|
|
|
68 |
pack .pass.entry2 -side top
|
|
2
|
69 |
bind .pass.entry2 <Return> {destroy .pass}
|
|
0
|
70 |
}
|
|
|
71 |
button .pass.ok -text "Ok" -command \
|
|
|
72 |
{ destroy .pass }
|
|
|
73 |
pack .pass.ok -side left
|
|
|
74 |
button .pass.cancel -text "Cancel" \
|
|
|
75 |
-command {set password1 ""; set password2 ""; destroy .pass}
|
|
|
76 |
pack .pass.cancel -side right
|
|
|
77 |
|
|
|
78 |
bind .pass.entry <Escape> {set password1 ""; set password2 ""; destroy .pass}
|
|
|
79 |
|
|
|
80 |
focus $tl
|
|
|
81 |
focus $tl.entry
|
|
|
82 |
grab $tl
|
|
|
83 |
tkwait window $tl
|
|
|
84 |
catch { grab release $tl }
|
|
|
85 |
focus .
|
|
|
86 |
|
|
|
87 |
if { $entries != 2 } {
|
|
|
88 |
set tmppass $password1
|
|
|
89 |
set password1 ""
|
|
|
90 |
return $tmppass
|
|
|
91 |
}
|
|
|
92 |
|
|
|
93 |
if { $password1 == $password2 } {
|
|
|
94 |
set tmppass $password1
|
|
|
95 |
set password1 ""
|
|
|
96 |
set password2 ""
|
|
|
97 |
return $tmppass
|
|
|
98 |
} else {
|
|
|
99 |
set password1 ""
|
|
|
100 |
set password2 ""
|
|
|
101 |
tk_messageBox -type ok -message "The passwords don't match" \
|
|
|
102 |
-icon error
|
|
|
103 |
return ""
|
|
|
104 |
}
|
|
|
105 |
}
|
|
|
106 |
|
|
|
107 |
proc newfile { } {
|
|
|
108 |
global actualpass actualfile
|
|
|
109 |
set actualpass ""
|
|
|
110 |
set actualfile ""
|
|
2
|
111 |
.text delete 1.0 end
|
|
3
|
112 |
wm title . "tkccrypt - New File"
|
|
0
|
113 |
}
|
|
|
114 |
|
|
|
115 |
proc openfile { } {
|
|
2
|
116 |
global env actualpass actualfile filetypes
|
|
|
117 |
set file [tk_getOpenFile -defaultextension .cpt -filetypes $filetypes]
|
|
|
118 |
|
|
|
119 |
if { $file == ""} {
|
|
|
120 |
return
|
|
|
121 |
}
|
|
|
122 |
|
|
0
|
123 |
set pass [askpassword "Open" 1]
|
|
|
124 |
|
|
|
125 |
if { $pass == "" } { return }
|
|
|
126 |
|
|
|
127 |
# Decode
|
|
|
128 |
set env(PASS) $pass
|
|
|
129 |
|
|
|
130 |
set error [ catch { set txt [exec ccrypt -dc -E PASS $file] } result ]
|
|
|
131 |
if { $error != 0 } {
|
|
|
132 |
tk_messageBox -type ok -message "Password incorrect:\n$result" \
|
|
|
133 |
-icon error
|
|
|
134 |
return
|
|
|
135 |
}
|
|
|
136 |
|
|
|
137 |
.text delete 1.0 end
|
|
|
138 |
.text insert end $txt
|
|
|
139 |
# while { [eof $fd ] != 1 } {
|
|
|
140 |
# set line [gets $fd]
|
|
|
141 |
# .text insert end $line
|
|
|
142 |
# }
|
|
|
143 |
|
|
|
144 |
set env(PASS) ""
|
|
|
145 |
|
|
|
146 |
set actualpass $pass
|
|
|
147 |
set actualfile $file
|
|
3
|
148 |
wm title . "tkccrypt - $file"
|
|
0
|
149 |
}
|
|
|
150 |
|
|
|
151 |
proc savefile { {file ""} {pass ""} } {
|
|
2
|
152 |
global env actualpass actualfile filetypes
|
|
0
|
153 |
|
|
|
154 |
if { $file == "" } {
|
|
2
|
155 |
set file [tk_getSaveFile -defaultextension .cpt -filetypes \
|
|
|
156 |
$filetypes]
|
|
|
157 |
}
|
|
|
158 |
|
|
|
159 |
if { $file == ""} {
|
|
|
160 |
return
|
|
0
|
161 |
}
|
|
|
162 |
|
|
|
163 |
if { $pass == "" } {
|
|
|
164 |
set pass [askpassword "Save" 2]
|
|
|
165 |
|
|
|
166 |
if { $pass == "" } { return }
|
|
|
167 |
}
|
|
|
168 |
|
|
|
169 |
# Decode
|
|
|
170 |
set env(PASS) $pass
|
|
|
171 |
|
|
|
172 |
set error [ catch { set fd [open "|ccrypt -E PASS >$file" w] } result ]
|
|
|
173 |
if { $error != 0 } {
|
|
|
174 |
tk_messageBox -type ok -message "Password incorrect:\n$result" \
|
|
|
175 |
-icon error
|
|
|
176 |
return
|
|
|
177 |
}
|
|
|
178 |
|
|
|
179 |
puts -nonewline $fd [.text get 1.0 end]
|
|
|
180 |
close $fd
|
|
|
181 |
|
|
|
182 |
set env(PASS) ""
|
|
2
|
183 |
set actualpass $pass
|
|
0
|
184 |
set actualfile $file
|
|
3
|
185 |
wm title . "tkccrypt - $file"
|
|
0
|
186 |
tk_messageBox -type ok -message "File \"$file\" saved!" \
|
|
|
187 |
-icon info
|
|
|
188 |
}
|