#!/usr/bin/wish

set version "v14.12 (Windows)"

package require des
package require aes
package require blowfish
package require rc4
package require sha256
package require ripemd160
package require base64
package require zlib

proc endapp {} {
	set ov [tk_messageBox -detail "Would you like to clear the system clipboard?" \
		-title "Clear Clipboard Dialog" \
		-icon question \
		-type yesnocancel]
	switch -- $ov {
		yes {
			clipboard clear
			tk_messageBox -detail "Clipboard cleared"
			exit
		}
		no {
			exit
		}
		cancel {
			return
		}
	}
}

proc file_mtime {infile} {
	file mtime $infile [expr {int(rand()*[clock seconds])}]
}

proc about {} {
	upvar version version
	tk_messageBox -detail "Portable text encryption version $version"
}

proc clear {} {
	.verybottom.lb delete 1.0 end
	.verybottom.lb configure -wrap none
	.rockbottom.lb delete 1.0 end
	.rockbottom.lb configure -wrap char
}

proc clear_top {} {
	.verybottom.lb delete 1.0 end
	.verybottom.lb configure -wrap none
}

proc clear_bottom {} {
	.rockbottom.lb delete 1.0 end
	.rockbottom.lb configure -wrap char
}

proc import_textfile {} {
    set ftype {
		{{Text Files} {.txt .text}}
		{{All Files} * }
	}
	set getenctext [tk_getOpenFile -filetypes $ftype]
	if {[file isfile $getenctext] == 0} {
		tk_messageBox -detail "No File Chosen, Returning"
		return
	}
	set geet [open "$getenctext" "r"]
	fconfigure $geet -translation binary
	set tte [read $geet]
	close $geet
	.verybottom.lb delete 1.0 end
	.verybottom.lb insert 1.0 $tte
}

proc import_ciphertext {} {
    set ftype {
		{{CipherText Files} {.ctxt}}
		{{All Files} * }
	}
	set getenctext [tk_getOpenFile -filetypes $ftype]
	if {[file isfile $getenctext] == 0} {
		tk_messageBox -detail "No File Chosen, Returning"
		return
	}
	set geet [open "$getenctext" "r"]
	fconfigure $geet -translation binary
	set tte [read $geet]
	close $geet
	.rockbottom.lb delete 1.0 end
	.rockbottom.lb insert 1.0 $tte
}

proc file_mtime {infile} {
	file mtime $infile [expr {int(rand()*[clock seconds])}]
}

proc formattext {lines addsalt eight firstseed firstseedstring} {
	set lines [base64::encode -maxlen 0 $lines]
	set counter 0; set slines ""
	while {$counter < 8} {
		set slines $slines[string index $addsalt $counter]
		set slines $slines[string index $lines $counter]
		incr counter
	}
	set lines $slines[string range $lines 8 end]
	set lines [string range $lines 0 $firstseed]$firstseedstring[string range $lines [expr $firstseed + 1] end]
	if {$eight < 1} {
		set resultlength [string length $lines]
		set resultlenthcounter 0
		set newline ""
		while {$resultlenthcounter <= $resultlength} {
			set counter 0
			while {$counter < 75} {
				set lineindex [string index $lines $resultlenthcounter]
				set newline $newline$lineindex
				incr counter
				incr resultlenthcounter
			}
			set newline $newline\n
		}
		set lines $newline
	} else {
		.rockbottom.lb configure -wrap char
		set lines [string map {"\n" ""} $lines]
	}
	return $lines
}

proc hashpwandsalt {inhash} {
	set nps ""
	set pwsaltcount [sha2::sha256 $inhash]
	set counter 0
	while {$counter < 64} {
	    if {[string is digit [string index $pwsaltcount $counter]]} {
			set nps $nps[string index $pwsaltcount $counter]
    	}
    	incr counter
	}
	set npslength [string length $nps]
	set counter 0
	set passes $npslength
	while {$counter < $npslength} {
	    set passes [expr $passes + [string index $nps $counter]]
   		incr counter
	}
	return $passes
}

proc enctext {pwdone tte pwv cipher eight} {
	.verybottom.lb configure -wrap none
	.rockbottom.lb configure -wrap char
	
	set added [sha2::sha224 $pwdone]
	set q [ripemd::ripemd160 -hex $pwdone$added]
	set rcpad [string range [sha2::sha224 [clock seconds]] 6 9]
	set counter 0
	set firstseed 0
	while {$counter < 64} {
	    if {[string is digit [string index $q $counter]]} {
			set firstseed [string index $q $counter]
			set counter 64
    	}
    	incr counter
	}
	set q [sha2::sha224 $q]
	set firstseedstring [string index $q $firstseed]
	
	set tempq [sha2::sha256 -bin $q]
	set tempb [sha2::sha224 -bin $tempq]
	set biv [string range $tempb 0 7]
	if {$pwv == 0} {
		set salt [expr {int(rand()*[clock microseconds])}]
		set tsalt ""
		set saltlength [string length $salt]
		while {$saltlength >= 0} {
			set tsalt $tsalt[string index $salt [expr $saltlength - 1]]
			incr saltlength -1
		}
		set salt $tsalt
		set si [string index $salt 0]
		set counter 0
		set salt [sha2::sha256 $salt]
		set passes [hashpwandsalt $salt]
		while {$counter <= $passes} {
			set salt [sha2::sha256 $salt]
			set salt [sha2::sha224 $salt$pwdone]
			incr counter
		}
		set salt [string range \
			[blowfish::blowfish -mode cbc -key $tempb -iv $biv -- \
			$salt] $si [expr $si + 5]]
		set addsalt [base64::encode [rc4::rc4 -key $tempq $salt]]
	} else {
		set tte [string range $tte 0 $firstseed][string range $tte [expr $firstseed + 2] end]
		set salt [base64::decode [string index $tte 0][string index $tte 2][string index $tte 4][string index $tte 6][string index $tte 8][string index $tte 10][string index $tte 12][string index $tte 14]]
		set salt [rc4::rc4 -key $tempq $salt]
		set stte [base64::decode [string index $tte 1][string index $tte 3][string index $tte 5][string index $tte 7][string index $tte 9][string index $tte 11][string index $tte 13][string index $tte 15]]
		set tte $stte[base64::decode [string range $tte 16 end]]
	}

	set counter 0
	set q [sha2::sha256 $q$salt]
	set passes [hashpwandsalt $q]
	while {$counter < $passes} {
		set q [sha2::sha224 $q$salt]
		set q [sha2::sha256 -bin $q]
		incr counter
	}

	set iv [sha2::sha256 $q$salt]

	if {[string range $cipher 0 2] == "aes"} {
		set iv [string range [sha2::sha256 $q$added] 0 15]
	} else {
		set iv [string range [sha2::sha256 $q$added] 0 7]
	}
	unset pwdone
	
	if {[string range $cipher 0 2] == "rc4"} {
		set q [sha2::sha256 $q]
		if {$pwv == 0} {
			set tte [zlib deflate $rcpad$tte 9]
		}
		set lines [rc4::rc4 -key $q -- $tte]
		if {$pwv == 1} {
			if {[catch {set lines [zlib inflate $lines]} msg]} {
				.verybottom.lb configure -wrap char
				tk_messageBox -detail "decryption failed, possible password problem or wrong cipher chosen"
				return
			}
			set lines [string range $lines 4 [expr [string length $lines] -2]]
		}
	}
	if {[string range $cipher 0 2] == "des" || [string index $cipher 0] == "3"} {
		set modestring [string range $cipher [expr [string length $cipher] - 3] end]
		if {[string index $cipher 0] == "3"} {
			set q [string range $q 0 23]
		} else {
			set q [string range $q 0 15]
		}
		if {$pwv == 0} {
			set tte [zlib deflate $tte 9]
			set lines [DES::des -mode $modestring -iv $iv -key $q -- $tte]
		} else {
			set lines [DES::des -mode $modestring -dir decrypt -iv $iv -key $q -- $tte]
			if {[catch {set lines [zlib inflate $lines]} msg]} {
				.verybottom.lb configure -wrap char
				tk_messageBox -detail "decryption failed, possible password problem or wrong cipher chosen"
				return
			}
			set lines [string range $lines 0 [expr [string length $lines] -2]]
		}
	}
	if {[string range $cipher 0 2] == "aes"} {
		set modestring [string range $cipher 8 10]
		if {[string range $cipher 4 6] == "192"} {
			set q [string range $q 0 23]
		} elseif {[string range $cipher 4 6] == "128"} {
			set q [string range $q 0 15]
		}
		if {$pwv == 0} {
			set tte [zlib deflate $tte 9]
			set lines [aes::aes -mode $modestring -iv $iv -key $q -- $tte]
		} else {
			set lines [aes::aes -mode $modestring -dir decrypt -iv $iv -key $q -- $tte]
			if {[catch {set lines [zlib inflate $lines]} msg]} {
				.verybottom.lb configure -wrap char
				tk_messageBox -detail "decryption failed, possible password problem or wrong cipher chosen"
				return
			}
			set lines [string range $lines 0 [expr [string length $lines] -2]]
		}
	}
	if {[string range $cipher 0 2] == "blo"} {
		set modestring [string range $cipher 9 11]
		set q [string range $q[sha2::sha256 -bin $q] 0 55]
		if {$pwv == 0} {
			set tte [zlib deflate $tte 9]
			set lines [blowfish::blowfish -mode $modestring -iv $iv -key $q -- $tte]
		} else {
			set lines [blowfish::blowfish -mode $modestring -dir decrypt -iv $iv -key $q -- $tte]
			if {[catch {set lines [zlib inflate $lines]} msg]} {
				.verybottom.lb configure -wrap char
				tk_messageBox -detail "decryption failed, possible password problem or wrong cipher chosen"
				return
			}
			set lines [string range $lines 0 [expr [string length $lines] -2]]
		}
	}
	if {$pwv eq 0} {
		set lines [string trim \
			[formattext $lines $addsalt $eight $firstseed $firstseedstring]]
	}
	if {$pwv == 0} {
		.rockbottom.lb delete 1.0 end
		.rockbottom.lb insert end $lines
	} else {
		.verybottom.lb delete 1.0 end
		.verybottom.lb insert end $lines
	}
	if {$pwv == 0} {
		set savetext [tk_messageBox \
			-title "Save File" \
			-detail "Save Result to File?" \
			-type yesno \
			-default no \
			-icon question]
		if {$savetext eq yes} {
			set j [.rockbottom.lb get 1.0 end]
			set ftype {
				{{Text Files} {.ctxt}}
				{{All Files} * }
			}
			set opf [tk_getSaveFile -filetypes $ftype -defaultextension .ctxt]
			if {$opf == ""} {
				tk_messageBox -title "Cancelled" -detail "No Filename Given, Result Not Saved"
				return
			}		
			set set [open "$opf" "w"]
			fconfigure $set -translation binary
			puts $set $j
			close $set
			set random_ts [tk_messageBox \
				-title "Randomize" \
				-detail "Randomize timestamp?" \
				-type yesno \
				-default no \
				-icon question]
			if {$random_ts eq yes} {
				file_mtime $opf
			}
			tk_messageBox -title "File Saved" -detail "Result Saved in File $opf"
		}
	}
}

proc getpwd {pwv tte} {
	upvar cipher cipher
	set listofciphers {
		aes-128-ecb
		aes-128-cbc
		aes-192-ecb
		aes-192-cbc
		aes-256-ecb
		aes-256-cbc
		blowfish-ecb
		blowfish-cbc
		des-ecb
		des-cbc
		des-cfb
		des-ofb
		3des-ecb
		3des-cbc
		3des-cfb
		3des-ofb
		rc4
	}

	toplevel .password
	.password configure -width 500 -height 165
	wm title .password "Password Dialog"
	wm resizable .password 0 0
	
	frame .password.one -relief ridge -borderwidth 2 -padx 3 -pady 1 -width 480 -height 48
	place .password.one -x 10 -y 3
	
	grid [label .password.one.tryonelabel -text "Password:"]
	grid [entry .password.one.tryoneentry -show "*" -textvariable pwdone -background white -width 62]
	.password.one.tryoneentry delete 0 end
	place .password.one.tryonelabel -x 4 -y 10
	place .password.one.tryoneentry -x 80 -y 12

	if {$pwv == 0} {
		frame .password.two -relief ridge -borderwidth 2 -padx 3 -pady 1 -width 480 -height 48
		place .password.two -x 10 -y 55
	
		grid [label .password.two.trytwolabel -text "Repeat pwd:"]
		grid [entry .password.two.trytwoentry -show "*"  -textvariable pwdtwo -background white -width 62]
		.password.two.trytwoentry delete 0 end
		place .password.two.trytwolabel -x 4 -y 10
		place .password.two.trytwoentry -x 80 -y 12
		set eord "Encrypt"
	} else {
		set eord "Decrypt"
	}
	
	frame .password.button -borderwidth 2 -padx 3 -pady 2 -width 480 -height 48
	place .password.button -x 10 -y 120
	grid [button .password.button.b  -background grey65 -text $eord -pady 3 -width 12 -command {
		destroy .password
		if {$pwv == 0} {
			if {$pwdone != $pwdtwo} {
				tk_messageBox -detail "Passwords don't match, returning"
				return
			}
		}
		if {$pwdone eq ""} {
			tk_messageBox -detail "No password given, returning"
			return
		}
		enctext $pwdone $tte $pwv $cipher $eight
		unset eight
	}]
	grid [button .password.button.c  -background grey65 -text Cancel -pady 3 -width 12 -command {
		destroy .password
		set pwdone ""
		set pwdtwo ""
		return
	}]
	grid [ttk::combobox .password.button.cb -textvariable cipher -values $listofciphers -background white -width 14 -state readonly]
	.password.button.cb set $cipher

	grid [checkbutton .password.button.eight -variable eight -text "No L\/F's In Output"]
	if {$pwv == 1} {
		.password.button.eight configure -state disabled
	}
	place .password.button.eight -x 340 -y 4
    place .password.button.cb -x 220 -y 5
	place .password.button.b -x 0
	place .password.button.c -x 100
	focus -force .password.one.tryoneentry		
}

proc test_boxes {x} {
	set r 0
	if {$x == 0} {
		set tbox [string trim [.rockbottom.lb get 1.0 end]]
		if {[string length $tbox] > 1} {
			set cl [tk_messageBox \
				-title "Clear Ciphertext Box" \
				-detail "The ciphertext box is not empty, clear and continue?" \
				-type yesno \
				-default no \
				-icon question]
			if {$cl eq yes} {
				.rockbottom.lb delete 1.0 end
				.rockbottom.lb configure -wrap char
			} else {
				set r 1
			}
		}
	} else {
		set tbox [.verybottom.lb get 1.0 end]
		if {[string length $tbox] > 1} {
			set cl [tk_messageBox \
				-title "Clear Plaintext Box" \
				-detail "The plaintext box is not empty, clear and continue?" \
				-type yesno \
				-default no \
				-icon question]
			if {$cl eq yes} {
				.verybottom.lb delete 1.0 end
				.verybottom.lb configure -wrap none
			} else {
				set r 1
			}

		}
	}
	return $r
}

proc main {} {
	upvar version version
	. configure -width 750 -height 570
	wm title . "Portable text encryption"
	wm resizable . 0 0
	wm protocol . WM_DELETE_WINDOW {endapp}
	focus -force .

	frame .verybottom -borderwidth 1 -padx 1 -pady 1 -height 20 -width 750
	place .verybottom -x 5 -y 4

	menu .mbar -backgroun grey90
	. configure -menu .mbar

	menu .mbar.fl -tearoff 0
	menu .mbar.he -tearoff 0
	.mbar add cascade -menu .mbar.fl -label File -underline 0
	.mbar add cascade -menu .mbar.he -label Help -underline 0

	.mbar.fl add command -label "Encrypt Text" -command {
		set pwv 0
		set r [test_boxes $pwv]
		if {$r > 0} {
			return
		}
		set tte [.verybottom.lb get 1.0 end]
		if {[string length $tte] < 2} {
			tk_messageBox -detail "Empty Text Box, Returning"
			return
		}
		set tte [string map {"\r\n" "\n"} $tte]
		getpwd $pwv $tte
	}
	.mbar.fl add command -label "Decrypt Text" -command {
		set pwv 1
		set r [test_boxes $pwv]
		if {$r > 0} {
			return
		}
		set tte [.rockbottom.lb get 1.0 end]
		if {[string length $tte] < 2} {
			tk_messageBox -detail "Empty Ciphertext Box, Returning"
			return
		}
		set tte [string map {"\r\n" "\n"} $tte]
		set tte [string map {" " ""} $tte]
		getpwd $pwv $tte
	}
	.mbar.fl add command -label "Read Textfile" -command {
		import_textfile
	}
	.mbar.fl add command -label "Clear Both Text Boxes" -command {
		clear
	}
	.mbar.fl add separator

	.mbar.fl add command -label Exit -command {endapp}
	.mbar.he add command -label About -command {about}

	grid [text .verybottom.lb -wrap none -pady 5 -background white -width 89 -height 13 -yscrollcommand ".verybottom.sbv set" -xscrollcommand ".verybottom.sbh set"]
	grid [scrollbar .verybottom.sbv -command ".verybottom.lb yview" -orient vertical -background white] -column 1 -row 0 -sticky ns
	grid [scrollbar .verybottom.sbh -command ".verybottom.lb xview" -orient horizontal -background white] -column 0 -row 1 -sticky ew
	bind .verybottom.lb <KP_Enter>
	focus -force .verybottom.lb


######################### mid button frame	
	frame .morebottom -borderwidth 1 -padx 1 -pady 1 -height 33 -width 745
	place .morebottom -x 4 -y 250
	
	grid [button .morebottom.enc  -background grey65 -text "Encrypt Top Box" \
		-pady 3 -width 18 -command {
			set pwv 0
			set r [test_boxes $pwv]
			if {$r > 0} {
				return
			}
			set tte [.verybottom.lb get 1.0 end]
			if {[string length $tte] < 2} {
				tk_messageBox -detail "Empty Text Box, Returning"
				return
			}
			set tte [string map {"\r\n" "\n"} $tte]
			getpwd $pwv $tte
	}]
	grid [button .morebottom.dec  -background grey65 -text "Decrypt Bottom Box" \
		-pady 3 -width 18 -command {
			set pwv 1
			set r [test_boxes $pwv]
			if {$r > 0} {
				return
			}
			set tte [.rockbottom.lb get 1.0 end]
			if {[string length $tte] < 2} {
				tk_messageBox -detail "Empty Ciphertext Box, Returning"
				return
			}
			set tte [string map {"\r\n" "\n"} $tte]
			set tte [string map {" " ""} $tte]
			getpwd $pwv $tte
	}]
	grid [button .morebottom.imp  -background grey65 -text "Import Textfile" \
		-pady 3 -width 18 -command {
        import_textfile
	}]
	grid [button .morebottom.cmp  -background grey65 -text "Import Ciphertext" \
		-pady 3 -width 18 -command {
        import_ciphertext
	}]
	grid [button .morebottom.clt  -background grey65 -text "CLR \^" \
		-pady 3 -width 7 -command {
        clear_top
	}]
	grid [button .morebottom.clb  -background grey65 -text "CLR v" \
		-pady 3 -width 7 -command {
        clear_bottom
	}]
	place .morebottom.enc -x 0 -y 0
	place .morebottom.dec -x 137 -y 0
	place .morebottom.imp -x 274 -y 0
	place .morebottom.cmp -x 411 -y 0
	place .morebottom.clt -x 592 -y 0
	place .morebottom.clb -x 652 -y 0
	
############################ bottome text box frame
	frame .rockbottom -borderwidth 1 -padx 1 -pady 1 -height 20 -width 750
	place .rockbottom -x 5 -y 288
	
	grid [text .rockbottom.lb -wrap char -pady 5 -background white -width 89 -height 13 -yscrollcommand ".rockbottom.sbv set" -xscrollcommand ".rockbottom.sbh set"]
	grid [scrollbar .rockbottom.sbv -command ".rockbottom.lb yview" -orient vertical -background white] -column 1 -row 0 -sticky ns
	grid [scrollbar .rockbottom.sbh -command ".rockbottom.lb xview" -orient horizontal -background white] -column 0 -row 1 -sticky ew
	
############################ clipboard stuff
	frame .clip -borderwidth 1 -padx 1 -pady 1 -height 33 -width 745
	place .clip -x 4 -y 530
	
	grid [button .clip.top  -background grey65 -text "Send Plaintext to Clipboard" \
		-pady 3 -width 48 -command {
        clipboard clear
		clipboard append [.verybottom.lb get 1.0 end]
	}]
	grid [button .clip.bot  -background grey65 -text "Send Ciphertext to Clipboard" \
		-pady 3 -width 48 -command {
        clipboard clear
		clipboard append [.rockbottom.lb get 1.0 end]
	}]
	place .clip.top -x 0 -y 0
	place .clip.bot -x 365 -y 0
}

set cipher aes-128-ecb
main
