#!/usr/bin/wish

package require rc4
package require blowfish
package require aes
package require sha256
package require md4
package require crc16
package require zlib

set version "11.02"
set eight 0

proc protect_original {fname pwv} {
	if {$pwv == 3} {
		if {[file isfile [file rootname $fname]] > 0} {
			file copy [file rootname $fname] [file rootname $fname].original
		}
	} else {
		if {[file isfile $fname.f11] > 0} {
			file copy $fname.f11 $fname.f11.original
		}
	}
}

proc delete_original {fname pwv} {
	if {$pwv == 3} {
		catch {file delete [file rootname $fname].original}
	}
}


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

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 rb]
	set tte [read $geet]
	close $geet
	.verybottom.lb delete 1.0 end
	.verybottom.lb insert 1.0 $tte
}

proc overwrite {fname pwv} {
	set owfile yes
	if {$pwv == 1} {
		set fname $fname.f11
	} else {
		set fname [file rootname $fname]
	}
	if {[file isfile $fname] > 0} {
		set owfile [tk_messageBox -message "Overwrite existing file $fname?" \
		-title "Overwrite Source Dialog" \
		-icon question \
		-type yesno]
	}
	return $owfile
}

proc copypaste {cpmenu xx yy} {
	incr yy 0
	incr xx -40
    set x [expr [winfo rootx .]+$xx]
    set y [expr [winfo rooty .]+$yy]
    tk_popup $cpmenu $x $y
}

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 clear {} {
	.verybottom.lb delete 1.0 end
	.verybottom.lb configure -wrap none
}

proc about {} {
    upvar version version
	tk_messageBox -message "Fate - file and text encryption version $version"
}

proc hashpwandsalt {inhash} {
	set passes [string range [crc::crc16 $inhash] 0 2]
	if {[string index $passes 0] eq "0"} {
		set passes 1$passes
	}
	return [expr $passes - 1]
}

proc delfile {n} {
	set nx [file tail $n]
	set delf [tk_messageBox -message "Delete source file $nx?" \
		-title "Delete File Dialog" \
		-icon question \
		-type yesno]
	if {$delf == "yes"} {
        file delete $n
    }
	return
}

proc formattext {lines eight salt display_hash} {
	set lines [rc4::rc4 -hex -key $display_hash -- $lines$salt]
	if {$eight < 1} {
		set rlength [string length $lines]
		set rcount 0
		set newline ""
		while {$rcount <= $rlength} {
			set newline $newline[string range $lines $rcount [expr $rcount + 73]]\n
			incr rcount 74
		}
		set lines $newline
	} else {
		.verybottom.lb configure -wrap char
	}
	return $lines
}

proc enctxt {q tte pwv eight} {
	.verybottom.lb configure -wrap none
	set display_hash [sha2::sha256 $q]
	if {$pwv == 2} {
		set tte [string map {"\n" ""} $tte]
		if {[catch {set tte [rc4::rc4 -key $display_hash -- [binary decode hex $tte]]} msg]} {
			tk_messageBox -detail "bad decryption attempt"
			return
		}
	}
	if {$pwv == 0} {
		set salt [string range [clock milliseconds] 5 13]
	} else {
		set salt [string range $tte [expr [string length $tte] - 8] end]
		set tte [string range $tte 0 [expr [string length $tte] - 9]]
	}

	set passes [hashpwandsalt $q]
	for {set counter 0} {$counter < $passes} {incr counter} {
		set q [sha2::sha256 $q$salt]
	}

	set alk [string range [sha2::sha256 $q] 0 31]
	set blk [string range [sha2::sha256 $alk] 0 55]

	set aliv [string range [sha2::sha256 $blk] 0 15]
	set bliv [string range [sha2::sha256 $aliv] 0 7]

	if {$pwv == 0} {
		set tte [zlib deflate $tte 9]
		set lines [string trimright [formattext \
			[blowfish::blowfish -mode cbc -iv $bliv -key $blk \
			[aes::aes -mode cbc -iv $aliv -key $alk -- $tte]] \
			$eight $salt $display_hash]]
	} else {
		set lines [aes::aes -dir decrypt -mode cbc -iv $aliv -key $alk \
			[blowfish::blowfish -dir decrypt -mode cbc -iv $bliv -key $blk -- $tte]]
		if {[catch {set lines [zlib inflate $lines]} msg]} {
			.verybottom.lb configure -wrap char
			tk_messageBox -title "Error" -icon error -detail "bad password or corrupt ciphertext"
			return
		}
		set lines [string range $lines 0 [expr [string length $lines] -2]]
	}

	.verybottom.lb delete 1.0 end
	.verybottom.lb insert end $lines

	set saveclip [tk_messageBox \
		-title "Clipboard" \
		-detail "Copy Result to Clipboard?" \
		-type yesno \
		-default no \
		-icon question]
	if {$saveclip eq yes} {
		clipboard clear
		clipboard append "$lines"
		tk_messageBox -title "Success" -detail "Result copied to Clipboard"
	}
	
	set savetext [tk_messageBox \
		-title "Save File" \
		-detail "Save Result to File?" \
		-type yesno \
		-default no \
		-icon question]
	if {$savetext eq yes} {
		set j [.verybottom.lb get 1.0 end]
		set ftype {
			{{Text Files} {.txt .text}}
			{{All Files} * }
		}
		set opf [tk_getSaveFile -filetypes $ftype -defaultextension .txt]
		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 encfile {key in pwv} {
	set binroot [file dirname $in]
	set nowroot [pwd]
	set original $in
	set in [file tail $in]
	cd $binroot

	set encdict [dict create \
		0 aria-256-cbc \
		1 aria-256-cfb \
		2 aria-256-ofb \
		3 aria-256-ctr \
		4 camellia-256-cbc \
		5 camellia-256-cfb \
		6 camellia-256-ofb \
		7 camellia-256-ctr \
		8 chacha20]

	set salt_key $key
	set key [binary encode base64 [rc4::rc4 -key $key $key]]
	set tkey [sha2::sha224 $salt_key]

	if {$pwv == 1} {
		set cd_seed [expr {int(9*rand())}];# set cd_seed 8
		set cipher [dict get $encdict $cd_seed]
		set cd_insert [rc4::rc4 -key $key -- [string index [clock milliseconds] 12]$cd_seed]
		set original_hash [rc4::rc4 -key $tkey [sha2::sha256 [exec openssl dgst -md5 $in]]]
		set salt [string range [sha2::sha256 -bin [clock milliseconds]] 0 30]
	} else {
		set outfile [open temp.bin wb]
		set infile [open $in rb]
		set read_cd_info [string index [rc4::rc4 -key $key [read $infile 2]] 1]
		if {[catch {set cipher [dict get $encdict $read_cd_info]} > 0]} {
			tk_messageBox -detail "bad decryption attempt, returning"
			close $outfile; file delete temp.bin
			if {[file isfile [file rootname $original].original] > 0} {
				file delete [file rootname $original]
				file rename [file rootname $original].original [file rootname $original]
			}
			return
		}
		set salt [read $infile 31]
		set final_hash [binary encode base64 [read $infile 64]]
		fcopy $infile $outfile
		close $outfile
		close $infile
	}

	set passes [hashpwandsalt $key$salt]

	set counter 0
	while {$counter < $passes} {
		set key [md4::md4 $key]
		set key [sha2::sha256 $salt$key]
		incr counter
	}
	set iv [string range [sha2::sha224 $key] 0 31]

    set success 1;#tk_messageBox -detail $cipher
	if {$pwv == 3} {
		set out [file rootname $in]
		if {[catch {exec openssl enc -$cipher -iv $iv -d -in temp.bin -out $out -nosalt -K $key} msg]} {
			file delete $out
			tk_messageBox -detail "bad decryption attempt, returning"
			if {[file isfile [file rootname $original].original] > 0} {
				file delete [file rootname $original]
				file rename [file rootname $original].original [file rootname $original]
			}
			if {[file isfile ./temp.bin] > 0} {
				file delete ./temp.bin
			}
			return
		}
		file delete temp.bin

		if {[binary encode base64 [rc4::rc4 -key $tkey [sha2::sha256 [exec openssl dgst -md5 $out]]]] ne $final_hash} {
			file delete $out
			tk_messageBox -detail "bad decryption attempt, returning"
			if {[file isfile [file rootname $original].original] > 0} {
				file delete [file rootname $original]
				file rename [file rootname $original].original [file rootname $original]
			}
			return
		}
	} else {
		catch {exec openssl enc -$cipher -iv $iv -in $in -out footer.bin -nosalt -K $key}
		set outfile [open $in.f11_temp wb]
		puts -nonewline $outfile $cd_insert$salt$original_hash
		close $outfile
		exec cat $in.f11_temp footer.bin > $in.f11
		file delete footer.bin; file delete $in.f11_temp
	}
	cd $nowroot
	set in $original
   	if {$success == 1} {
       	if {$pwv == 3} {
       		tk_messageBox -detail "File decrypted, authentication verified"
		} else {
			tk_messageBox -detail "File encrypted"
		}
    }

	catch {file delete $original.f11.original}
	catch {file delete [file rootname $original].original}
	delfile $in
   	return
}

proc getpwd {pwv tte selectsource} {

	upvar eight eight
	unset eight
	if {$pwv == 1 || $pwv == 3} {
		if {$selectsource == ""} {
    	    return
	    }
		set tfn [file tail $selectsource]
		set title_text "encrypt / decrypt - $tfn"
	} else {
		set title_text "encrypt / decrypt textbox"
	}
   	toplevel .password
	.password configure -width 500 -height 180
	wm title .password $title_text
	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 92 -y 12

    if {$pwv < 2} {
       	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 92 -y 12
    }

	frame .password.button -borderwidth 2 -padx 3 -pady 2 -width 480 -height 202
	place .password.button -x 10 -y 120
   	grid [button .password.button.b  -background grey65 -text "Process" -pady 3 -width 9 -command {
		destroy .password
		if {$pwv == 0 || $pwv == 2} {
			if {[string length $tte] < 2} {
				delete_original $selectsource $pwv
				tk_messageBox -message "Empty text box, returning"
				return
			}
		}
		if {$pwv < 2} {
			if {$pwdone != $pwdtwo} {
				delete_original $selectsource $pwv
				tk_messageBox -message "Passwords don't match, returning"
				return
			}
		}
		if {[string length $pwdone] < 1 } {
			delete_original $selectsource $pwv
			tk_messageBox -message "No password given, returning"
			return
		}

		if {$pwv == 0 || $pwv == 2} {
			enctxt $pwdone $tte $pwv $eight
		} else {
			encfile $pwdone $selectsource $pwv
		}

	}]
    grid [button .password.button.cancel  -background grey65 -text "Cancel" -pady 3 -width 9 -command {
		delete_original $selectsource $pwv
        destroy .password
        return
	}]
	grid [checkbutton .password.button.eight -variable eight -text "No L\/F's In Output"]
	if {$pwv != 0} {
		.password.button.eight configure -state disabled
	}

    place .password.button.eight -x 270 -y 0
    place .password.button.b -x 0 -y 0
    place .password.button.cancel -x 75 -y 0
	focus -force .password.one.tryoneentry
}

proc main {} {
	. configure -width 750 -height 395
	wm title . "Fate - file and text encryption"
	wm resizable . 0 0
	wm protocol . WM_DELETE_WINDOW {endapp}
	focus -force .

	frame .verybottom -borderwidth 1 -padx 1 -pady 1 -height 15 -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 tte [.verybottom.lb get 1.0 end]
		if {[string length $tte] < 1} {
			tk_messageBox -message "Empty Text Box, Returning"
			return
		}
		set tte [string map {"\r\n" "\n"} $tte]
		getpwd $pwv $tte $selectsource
	}
	.mbar.fl add command -label "Decrypt Text" -command {
		set pwv 2
		set tte [.verybottom.lb get 1.0 end]
		if {[string length $tte] < 1} {
			tk_messageBox -message "Empty Text Box, Returning"
			return
		}
		set tte [string map {"\r\n" "\n"} $tte]
		set tte [string map {" " ""} $tte]
		getpwd $pwv $tte $selectsource
	}
	.mbar.fl add command -label "Read Textfile" -command {
		import_textfile
	}
	.mbar.fl add command -label "Clear Text Box" -command {
		clear
	}
	.mbar.fl add separator
	.mbar.fl add command -label "Encrypt File" -command {
		set pwv 1
		set tte ""
		set selectsource [tk_getOpenFile -title "File to Encrypt"]
		if {$selectsource != ""} {
			set ow [overwrite $selectsource $pwv]
			if {$ow eq yes} {
				protect_original $selectsource $pwv
				getpwd $pwv $tte $selectsource
			} else {
				tk_messageBox -message "Aborted" -icon info
			}
		}
	}
	.mbar.fl add command -label "Decrypt File" -command {
		set pwv 3
		set tte ""
   		set ftypeA {
			{{Helena encrypted files} {.f11} }
			{{All Files} * }		
		}
		set selectsource [tk_getOpenFile -title "File to Decrypt" -filetypes $ftypeA]
		if {$selectsource != ""} {
			set ow [overwrite $selectsource $pwv]
			if {$ow eq yes} {
				protect_original $selectsource $pwv
				getpwd $pwv $tte $selectsource
			} else {
				tk_messageBox -message "Aborted" -icon info
			}
		}
	}
	.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 22 -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
}

menu .cpmenu -tearoff 0
.cpmenu add command -label "Copy" -command {
	set vt [.verybottom.lb tag ranges sel]
	if {$vt == ""} {
		return
	}
	set vtl [split $vt " "]
	set vttag [.verybottom.lb get [lindex $vtl 0] [lindex $vtl 1]]
	clipboard clear
	clipboard append $vttag
}
.cpmenu add command -label "Paste" -command {
	if {[catch {set vp [clipboard get]} msg]} {
		tk_messageBox -message "Error $msg, Returning"
		return
	}
	set vp [string trim $vp]	
	set vt [.verybottom.lb tag ranges sel]
	if {$vt != ""} {
		set vtl [split $vt " "]
		set vttag [.verybottom.lb delete [lindex $vtl 0] [lindex $vtl 1]]
	}
	.verybottom.lb insert insert $vp
}
bind . <3> {copypaste .cpmenu %x %y}

set selectsource {}
main
