des.tcl

Linux下的MSN聊天程序源码

# des.tcl
# Port of Javascript implementation to Tcl 8.4 by Mac A. Cody,
# October 2002 - February 2003
#
# Paul Tero, July 2001
# http://www.shopable.co.uk/des.html
#
# Optimized for performance with large blocks by Michael Hayworth, November 2001
# http://www.netdealing.com
#
# This software is copyrighted (c) 2003 by Mac A. Cody.  All rights
# reserved.  The following terms apply to all files associated with
# the software unless explicitly disclaimed in individual files or
# directories.

# The authors hereby grant permission to use, copy, modify, distribute,
# and license this software for any purpose, provided that existing
# copyright notices are retained in all copies and that this notice is
# included verbatim in any distributions. No written agreement, license,
# or royalty fee is required for any of the authorized uses.
# Modifications to this software may be copyrighted by their authors and
# need not follow the licensing terms described here, provided that the
# new terms are clearly indicated on the first page of each file where
# they apply.

# IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.

# THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THIS SOFTWARE
# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
# MODIFICATIONS.

# GOVERNMENT USE: If you are acquiring this software on behalf of the
# U.S. government, the Government shall have only "Restricted Rights"
# in the software and related documentation as defined in the Federal 
# Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2).  If you
# are acquiring the software on behalf of the Department of Defense, the
# software shall be classified as "Commercial Computer Software" and the
# Government shall have only "Restricted Rights" as defined in Clause
# 252.227-7013 (c) (1) of DFARs.  Notwithstanding the foregoing, the
# authors grant the U.S. Government and others acting in its behalf
# permission to use and distribute the software in accordance with the
# terms specified in this license. 
namespace eval des {
    # Procedure: encrypt - Encryption front-end for the des procedure
    # Inputs:
    #   key     : The 64-bit DES key or the 192-bit 3DES key
    #             (Note: The lsb of each byte is ignored; odd parity
    #             is not required).
    #   message : String to be encrypted (Note: The string is
    #             extended with null characters to an integral
    #             multiple of eight bytes.
    #   mode    : DES mode 1=CBC, 0=ECB (default).
    #   iv      : The input vector used in CBC mode.
    # Output:
    #   The encrypted data string.
    proc encrypt {key message {mode 0} {iv {}}} {
	return [des $key $message 1 $mode $iv]
    }

    # Procedure: decrypt - Decryption front-end for the des procedure
    # Inputs:
    #   key     : The 64-bit DES key or the 192-bit 3DES key
    #             (Note: The lsb of each byte is ignored; odd parity
    #             is not required).
    #   message : String to be decrypted (Note: The string length
    #             must be an integral multiple of eight bytes.
    #   mode    : DES mode 1=CBC, 0=ECB (default).
    #   iv      : The input vector used in CBC mode.
    # Output:
    #   The encrypted or decrypted data string.
    proc decrypt {key message {mode 0} {iv {}}} {
	return [des $key $message 0 $mode $iv]
    }

    if { $initialize_amsn == 1 } {

	variable spfunction1 [list 0x1010400 0 0x10000 0x1010404 0x1010004 0x10404 0x4 0x10000 0x400 0x1010400 0x1010404 0x400 0x1000404 0x1010004 0x1000000 0x4 0x404 0x1000400 0x1000400 0x10400 0x10400 0x1010000 0x1010000 0x1000404 0x10004 0x1000004 0x1000004 0x10004 0 0x404 0x10404 0x1000000 0x10000 0x1010404 0x4 0x1010000 0x1010400 0x1000000 0x1000000 0x400 0x1010004 0x10000 0x10400 0x1000004 0x400 0x4 0x1000404 0x10404 0x1010404 0x10004 0x1010000 0x1000404 0x1000004 0x404 0x10404 0x1010400 0x404 0x1000400 0x1000400 0 0x10004 0x10400 0 0x1010004];
	variable spfunction2 [list 0x80108020 0x80008000 0x8000 0x108020 0x100000 0x20 0x80100020 0x80008020 0x80000020 0x80108020 0x80108000 0x80000000 0x80008000 0x100000 0x20 0x80100020 0x108000 0x100020 0x80008020 0 0x80000000 0x8000 0x108020 0x80100000 0x100020 0x80000020 0 0x108000 0x8020 0x80108000 0x80100000 0x8020 0 0x108020 0x80100020 0x100000 0x80008020 0x80100000 0x80108000 0x8000 0x80100000 0x80008000 0x20 0x80108020 0x108020 0x20 0x8000 0x80000000 0x8020 0x80108000 0x100000 0x80000020 0x100020 0x80008020 0x80000020 0x100020 0x108000 0 0x80008000 0x8020 0x80000000 0x80100020 0x80108020 0x108000];
	variable spfunction3 [list 0x208 0x8020200 0 0x8020008 0x8000200 0 0x20208 0x8000200 0x20008 0x8000008 0x8000008 0x20000 0x8020208 0x20008 0x8020000 0x208 0x8000000 0x8 0x8020200 0x200 0x20200 0x8020000 0x8020008 0x20208 0x8000208 0x20200 0x20000 0x8000208 0x8 0x8020208 0x200 0x8000000 0x8020200 0x8000000 0x20008 0x208 0x20000 0x8020200 0x8000200 0 0x200 0x20008 0x8020208 0x8000200 0x8000008 0x200 0 0x8020008 0x8000208 0x20000 0x8000000 0x8020208 0x8 0x20208 0x20200 0x8000008 0x8020000 0x8000208 0x208 0x8020000 0x20208 0x8 0x8020008 0x20200];
	variable spfunction4 [list 0x802001 0x2081 0x2081 0x80 0x802080 0x800081 0x800001 0x2001 0 0x802000 0x802000 0x802081 0x81 0 0x800080 0x800001 0x1 0x2000 0x800000 0x802001 0x80 0x800000 0x2001 0x2080 0x800081 0x1 0x2080 0x800080 0x2000 0x802080 0x802081 0x81 0x800080 0x800001 0x802000 0x802081 0x81 0 0 0x802000 0x2080 0x800080 0x800081 0x1 0x802001 0x2081 0x2081 0x80 0x802081 0x81 0x1 0x2000 0x800001 0x2001 0x802080 0x800081 0x2001 0x2080 0x800000 0x802001 0x80 0x800000 0x2000 0x802080];
	variable spfunction5 [list 0x100 0x2080100 0x2080000 0x42000100 0x80000 0x100 0x40000000 0x2080000 0x40080100 0x80000 0x2000100 0x40080100 0x42000100 0x42080000 0x80100 0x40000000 0x2000000 0x40080000 0x40080000 0 0x40000100 0x42080100 0x42080100 0x2000100 0x42080000 0x40000100 0 0x42000000 0x2080100 0x2000000 0x42000000 0x80100 0x80000 0x42000100 0x100 0x2000000 0x40000000 0x2080000 0x42000100 0x40080100 0x2000100 0x40000000 0x42080000 0x2080100 0x40080100 0x100 0x2000000 0x42080000 0x42080100 0x80100 0x42000000 0x42080100 0x2080000 0 0x40080000 0x42000000 0x80100 0x2000100 0x40000100 0x80000 0 0x40080000 0x2080100 0x40000100];
	variable spfunction6 [list 0x20000010 0x20400000 0x4000 0x20404010 0x20400000 0x10 0x20404010 0x400000 0x20004000 0x404010 0x400000 0x20000010 0x400010 0x20004000 0x20000000 0x4010 0 0x400010 0x20004010 0x4000 0x404000 0x20004010 0x10 0x20400010 0x20400010 0 0x404010 0x20404000 0x4010 0x404000 0x20404000 0x20000000 0x20004000 0x10 0x20400010 0x404000 0x20404010 0x400000 0x4010 0x20000010 0x400000 0x20004000 0x20000000 0x4010 0x20000010 0x20404010 0x404000 0x20400000 0x404010 0x20404000 0 0x20400010 0x10 0x4000 0x20400000 0x404010 0x4000 0x400010 0x20004010 0 0x20404000 0x20000000 0x400010 0x20004010];
	variable spfunction7 [list 0x200000 0x4200002 0x4000802 0 0x800 0x4000802 0x200802 0x4200800 0x4200802 0x200000 0 0x4000002 0x2 0x4000000 0x4200002 0x802 0x4000800 0x200802 0x200002 0x4000800 0x4000002 0x4200000 0x4200800 0x200002 0x4200000 0x800 0x802 0x4200802 0x200800 0x2 0x4000000 0x200800 0x4000000 0x200800 0x200000 0x4000802 0x4000802 0x4200002 0x4200002 0x2 0x200002 0x4000000 0x4000800 0x200000 0x4200800 0x802 0x200802 0x4200800 0x802 0x4000002 0x4200802 0x4200000 0x200800 0 0x2 0x4200802 0 0x200802 0x4200000 0x800 0x4000002 0x4000800 0x800 0x200002];
	variable spfunction8 [list 0x10001040 0x1000 0x40000 0x10041040 0x10000000 0x10001040 0x40 0x10000000 0x40040 0x10040000 0x10041040 0x41000 0x10041000 0x41040 0x1000 0x40 0x10040000 0x10000040 0x10001000 0x1040 0x41000 0x40040 0x10040040 0x10041000 0x1040 0 0 0x10040040 0x10000040 0x10001000 0x41040 0x40000 0x41040 0x40000 0x10041000 0x1000 0x40 0x10040040 0x1000 0x41040 0x10001000 0x40 0x10000040 0x10040000 0x10040040 0x10000000 0x40000 0x10001040 0 0x10041040 0x40040 0x10000040 0x10040000 0x10001000 0x10001040 0 0x10041040 0x41000 0x41000 0x1040 0x1040 0x40040 0x10000000 0x10041000];

	variable desEncrypt {0 32 2}
	variable desDecrypt {30 -2 -2}
	variable des3Encrypt {0 32 2 62 30 -2 64 96 2}
	variable des3Decrypt {94 62 -2 32 64 2 30 -2 -2}
    }

    # Procedure: des
    # Inputs:
    #   key     : The 64-bit DES key or the 192-bit 3DES key
    #             (Note: The lsb of each byte is ignored; odd parity
    #             is not required).
    #   message : String to be encrypted or decrypted (Note: For
    #             encryption, the string is extended with null
    #             characters to an integral multiple of eight bytes.
    #             For decryption, the string length must be an integral
    #             multiple of eight bytes.
    #   encrypt : Perform encryption (1) or decryption (0)
    #   mode    : DES mode 1=CBC, 0=ECB (default).
    #   iv      : The input vector used in CBC mode.
    # Output:
    #   The encrypted or decrypted data string.
    proc des {key message encrypt {mode 0} {iv {}}} {
	variable spfunction1
	variable spfunction2
	variable spfunction3
	variable spfunction4
	variable spfunction5
	variable spfunction6
	variable spfunction7
	variable spfunction8
	variable desEncrypt
	variable desDecrypt
	variable des3Encrypt
	variable des3Decrypt

	# Create the 16 or 48 subkeys we will need
	set keys [createKeys $key];
	set m 0
	set cbcleft 0x00; set cbcleft2 0x00
	set cbcright 0x00; set cbcright2 0x00
	set len [string length $message];
	set chunk 0;
	# Set up the loops for single and triple des
	set iterations [expr {[llength $keys] == 32 ? 3 : 9}]; # Single or triple des
	if {$iterations == 3} {
	    expr {$encrypt ? [set looping $desEncrypt] : [set looping $desDecrypt]}
	} else {
	    expr {$encrypt ? [set looping $des3Encrypt] : [set looping $des3Decrypt]}
	}

	append message "\0\0\0\0\0\0\0\0"; # Pad the message out with null bytes
	# Store the result here
	set result {};
	set tempresult {};

	# CBC mode
	if {$mode == 1} {
	    binary scan $iv H8H8 cbcleftTemp cbcrightTemp
	    set cbcleft "0x$cbcleftTemp"
	    set cbcright "0x$cbcrightTemp"
	}

	# Loop through each 64 bit chunk of the message
	while {$m < $len} {
	    binary scan $message x${m}H8H8 lefttemp righttemp
	    set left {}
	    append left "0x" $lefttemp
	    set right {}
	    append right "0x" $righttemp
	    incr m 8

	    #puts "Left start: $left";
	    #puts "Right start: $right";
	    # For Cipher Block Chaining mode, xor the message with the previous result
	    if {$mode == 1} {
		if {$encrypt} {
		    set left [expr {$left ^ $cbcleft}]
		    set right [expr {$right ^ $cbcright}]
		} else {
		    set cbcleft2 $cbcleft;
		    set cbcright2 $cbcright;
		    set cbcleft $left;
		    set cbcright $right;
		}
	    }

	    #puts "Left mode: $left";
	    #puts "Right mode: $right";
	    #puts "cbcleft: $cbcleft";
	    #puts "cbcleft2: $cbcleft2";
	    #puts "cbcright: $cbcright";
	    #puts "cbcright2: $cbcright2";

	    # First each 64 but chunk of the message must be permuted according to IP
	    set temp [expr {(($left >> 4) ^ $right) & 0x0f0f0f0f}];
	    set right [expr {$right ^ $temp}];
	    set left [expr {$left ^ ($temp << 4)}];
	    set temp [expr {(($left >> 16) ^ $right) & 0x0000ffff}];
	    set right [expr {$right ^ $temp}];
	    set left [expr {$left ^ ($temp << 16)}];
	    set temp [expr {(($right >> 2) ^ $left) & 0x33333333}];
	    set left [expr {$left ^ $temp}]; set right [expr {$right ^ ($temp << 2)}];
	    set temp [expr {(($right >> 8) ^ $left) & 0x00ff00ff}];
	    set left [expr {$left ^ $temp}];
	    set right [expr {$right ^ ($temp << 8)}];
	    set temp [expr {(($left >> 1) ^ $right) & 0x55555555}];
	    set right [expr {$right ^ $temp}];
	    set left [expr {$left ^ ($temp << 1)}];

	    set left [expr {((($left << 1) & 0xffffffff) | (($left >> 31) & 0x00000001))}]; 
	    set right [expr {((($right << 1) & 0xffffffff) | (($right >> 31) & 0x00000001))}]; 

	    #puts "Left IP: [format %x $left]";
	    #puts "Right IP: [format %x $right]";

	    # Do this either 1 or 3 times for each chunk of the message
	    for {set j 0} {$j < $iterations} {incr j 3} {
		set endloop [lindex $looping [expr {$j + 1}]];
		set loopinc [lindex $looping [expr {$j + 2}]];

		#puts "endloop: $endloop";
		#puts "loopinc: $loopinc";

		# Now go through and perform the encryption or decryption  
		for {set i [lindex $looping $j]} {$i != $endloop} {incr i $loopinc} {
		    # For efficiency
		    set right1 [expr {$right ^ [lindex $keys $i]}]; 
		    set right2 [expr {((($right >> 4) & 0x0fffffff) | \
					   (($right << 28) & 0xffffffff)) ^ [lindex $keys [expr {$i + 1}]]}];
 
		    # puts "right1: [format %x $right1]";