1: #!/usr/bin/perl -w
2: #
3: # Chaffing/winowing utility
4: # (Achieving privacy without encryption)
5: # (Or 'textual steganography')
6: #
7: # See my Node [Privacy without Encryption]
8: # for more info about the used scheme
9: #
10: # TODO : _ Handle the packet size thru command line (or/and auto adapt size)
11: # packet size handling isn't coherent yet !!!
12: # _ Implement my 'modified' variant (without the sequence number)
13: # _ Find/correct bugs
14: # _ Find a way to handle LARGE files
15:
16: use strict; # Let's pretend we're doing it right ;-)
17:
18: use Compress::LZV1;
19: use Digest::MD5 qw(md5_base64);
20: use MIME::Base64;
21: use Getopt::Long;
22:
23: my $BSIZE = 32; # Block size
24: my $VERSION = '0.03'; # Did I mention pre-alpha ? ;-)
25:
26: #
27: # Command line options variable
28: #
29:
30: my $O_infile;
31: my $O_afile;
32: my $O_fake;
33: my $O_outfile;
34: my $O_encrypt;
35: my $O_decrypt;
36: my $O_key;
37: my $O_akey;
38: my $O_mpackets=4;
39:
40: GetOptions (
41: 'key=s' => \$O_key,
42: 'akey=s' => \$O_akey,
43: 'afile=s' => \$O_afile,
44: 'encrypt' => \$O_encrypt,
45: 'decrypt' => \$O_decrypt,
46: 'infile=s' => \$O_infile,
47: 'outfile=s', => \$O_outfile,
48: 'maxpackets=s', => \$O_mpackets,
49: '<>' => \&unknown
50: );
51: ############################################################
52: # Command line option handling
53: ############################################################
54: sub usage {
55: print "\n\t$0 - chaffing/winowing utility $VERSION\n\n";
56: print "\tUsage $0 (--encrypt | --decrypt) --infile=<file1> --outfile=<file2> --key=<key> [--afile=<file> --akey=<key>] [--maxpackets=<number>]\n\n";
57: print "\t\t--encrypt\t\tAsk for encryption&\n";
58: print "\t\t--decrypt\t\tAsk for decryption\n";
59: print "\t\t--infile=<file>\t\tInput file to be processed\n";
60: print "\t\t--afile=<file>\t\tAlternate input file to be processed\n";
61: print "\t\t--outfile=<file>\tOutput file to be produced\n\n";
62: print "\t\t--key=<key>\tKey used to authenticate\n\n";
63: print "\t\t--akey=<key>\tAlternate key used to authenticate\n\n";
64: print "\t\t--maxpackets=<number>\tMaximum number of packets generated for a part of the message\n\n";
65: }
66:
67: sub unknown {
68: print "Unknown option : ",shift,"\n" && usage();
69: }
70:
71: ############################################################
72: # Encryption subs
73: ############################################################
74:
75: ##############################
76: # pre encryption process to handle all-or-nothing encoding
77: #
78: sub preencrypt {
79: my $file = shift;
80: open (INFILE,"<$file") or die "Can't open $file ($!)\n";
81: my @content=<INFILE>;
82: close (INFILE);
83:
84: # May be I should do it step by step ?
85: my $temp = encode_base64(compress(join('',@content)),'');
86:
87: return reverse $temp;
88: }
89:
90: sub encrypt {
91: my $pos = 0;
92: my $length = 0;
93: my ($plaintext,$fake,$fprocessed);
94: my $processed=preencrypt($O_infile);
95:
96: if ($O_afile) { $fprocessed=preencrypt($O_afile) }
97:
98: $length=length($processed);
99:
100: if ($fprocessed && $length<length($fprocessed)) { $length=length($fprocessed) }
101:
102: open (OUTFILE,">$O_outfile") or die "Can't open $O_outfile ($!)\n";
103:
104: for(my $i=0;$pos<$length;$i++) {
105: if ($O_afile && ($pos<length($fprocessed))) {
106: $fake=substr($fprocessed,$pos,$BSIZE)
107: } else {
108: $fake= undef;
109: }
110: if ($pos<length($processed)) {
111: $plaintext=substr($processed,$pos,$BSIZE)
112: } else {
113: $plaintext=undef
114: }
115: my @packets=real_packets($i,$plaintext,$fake);
116: shuffle_packets(\@packets);
117: emit_packets(*OUTFILE,@packets);
118: $pos=$i*$BSIZE;
119: }
120: }
121:
122: ############################################################
123: # Decryption subs
124: ############################################################
125:
126: ##############################
127: # post decryption process to handle all-or-nothing encoding
128: #
129: sub postdecrypt {
130: my $temp2 = decode_base64(reverse(shift));
131: my $temp;
132: eval { $temp = decompress $temp2;}; # Don't trust the documentation
133: if ($@) { die "ERREUR=($@)()\n"}
134: return $temp;
135: }
136:
137: sub decrypt {
138: my @content;
139:
140: open (INFILE,"<$O_infile") or die "Can't open $O_outfile ($!)\n";
141: while (<INFILE>) {
142: my ($pos,$bloc,$mac)=split ',';
143: chomp $mac;
144: if (md5_base64($bloc.$O_key) eq $mac) { $content[$pos]=$bloc }
145: }
146: close(INFILE);
147: my $content=join '',@content;
148:
149:
150: open (OUTFILE,">$O_outfile") or die "Can't open $O_outfile ($!) \n";
151: my $processed=postdecrypt($content);
152: print OUTFILE $processed;
153: close(OUTFILE);
154: }
155:
156: ############################################################
157: # Packet building/manipulation subs
158: ############################################################
159:
160: ##############################
161: # Shuffle packets
162: #
163: sub shuffle_packets { # Fisher-Yates shuffling algo 'stolen' from a snowcrash's post.
164: my $t = shift;
165: my $x;
166: for ($x = @$t; --$x; ) {
167: my $y = int rand ($x+1);
168: next if $x == $y;
169: @$t[$x,$y] = @$t[$y,$x];
170: }
171: }
172:
173: ##############################
174: # Print the packets to the output file
175: #
176: sub emit_packets {
177: my $FH = shift;
178: my @pkt = @_;
179: foreach (@pkt) { print $FH $_ }
180: }
181:
182: ##############################
183: # Return a real packetS
184: #
185: sub real_packets {
186: my $step = shift;
187: my $plaintext = shift;
188: my $fake = shift;
189: my $mpackets = $O_mpackets;
190: my @packets;
191:
192: while ($mpackets--) {
193: if (!$mpackets) {
194: if ($plaintext) {
195: push @packets,real_packet($step,$plaintext,$O_key)
196: } else {
197: push @packets,fake_packet($step);
198: }
199: }
200: if (($O_afile)&&($mpackets==1)) {
201: if ($fake) {
202: push @packets,real_packet($step,$fake,$O_akey)
203: } else {
204: push @packets,fake_packet($step);
205: }
206: }
207: push @packets,fake_packet($step);
208: }
209: return @packets;
210: }
211:
212: ##############################
213: # Return a valid packet (wheat)
214: #
215: sub real_packet {
216: my $step = shift;
217: my $plaintext = shift;
218: my $key = shift;
219:
220: if ($plaintext) {
221: return "$step,$plaintext,".md5_base64($plaintext.$key)."\n";
222: } else {
223: return fake_packet($step)
224: }
225: }
226:
227: ##############################
228: # Return a fake packet (chaff)
229: #
230: sub fake_packet {
231: my $step = shift;
232:
233: return "$step,".rand_data().",".md5_base64(rand_data())."\n";
234: }
235:
236: ##############################
237: # Return random data
238: #
239: sub rand_data {
240: my $random =join '', map { chr(rand 255) } (1..24); #UGLY ! I'm not supposed to obfuscate
241: return encode_base64($random,'');
242: }
243:
244: ###################################################################
245: # Main program #
246: ###################################################################
247:
248: #
249: # Check for correct command line parameters
250: #
251: if ( ($O_encrypt && $O_decrypt) || (!$O_infile) ||
252: (!($O_encrypt || $O_decrypt)) || (!$O_outfile) || (!$O_key) ||
253: ($O_afile && !$O_akey) || (!$O_afile && $O_akey)) {
254: usage();
255: die
256: }
257:
258: #
259: # All is here ;-) guess what it does...
260: #
261: if ( $O_encrypt ) {
262: encrypt();
263: } elsif ( $O_decrypt ) {
264: decrypt();
265: }
266: #
267: # Following a 'chaffed' text
268: # try to decipher it using 'noilluminati' password
269: # (without quotes) after pasting it in a file and removing the #
270: #
271: #0,k5VXbo7skZ0eBw273YYuO0Z5ElzWK81p,++6IKesuyf71P1bd8fB+vQ
272: #0,==vCukGdh5WatVHbslEIlhGVKogLztmb,ZP6XzVcLHgfqXB+i9p7pVg
273: #0,Ngtvqm6sHXa9cakc578fugLZ6z7VCqFS,KquicDZSCPTwmIWCJQj2lw
274: #0,=ogIhASa0Fmbp1WdsxWSgwmclBFIv5GI,iaN8T9QW40NXzyMO3Ufr0g
275: #0,dXQbmi7tRep0RHSP2S5jL28foyXx4xc2,D13ZO25QvJmc5jj6Vs3Peg
276: #0,O/XXJoxtfLP7QejNSNhZXPeJEcY7EOgk,CDYs03Z42dMzAqgvt4NLOQ
277: #1,h0cBb46gj4e22g5BRN3EAQ7B/Ic444JJ,bKf3RiWEKW6AtG7gHek5YA
278: #1,Gc0LTGrpMBzsH1GYio6sqYc3jwSNguPM,2+NCOWj9rZ4Rl+VGBaa+bQ
279: #1,==vCukGdh5WatVHbslEIlhGVKogLztmb,ZP6XzVcLHgfqXB+i9p7pVg
280: #1,vOk9JaQWC3VGWgcuOrWhHCQv3ng1kbOp,XePqzBtcyTeOB7oYQROP1w
281: #1,WESG/Up8i9y1zLrplglsrXmQeDeC97n9,GkCJoaPkG0GsQwqxusvErQ
282: #1,=ogIhASa0Fmbp1WdsxWSgwmclBFIv5GI,iaN8T9QW40NXzyMO3Ufr0g
283: #2,v1GIlhGdgY2bgQ3cv1GIvRHI0VmcjV2c,3bQ70TJ8LprFvXmm027QKQ
284: #2,e6t59MmADzczzOxQUZPeuafSAHlsZzw6,87CMpxoNZ5V+ZXH16/xnog
285: #2,v27ZovnIWHa4RTIs0OZOqvrMoOQJsguw,HaYIHPDNKw01KTAZwDoz8A
286: #2,zlGIlJXZoRlIKogOggGd1JHdgkHbu9GI,YtuomVRssOL5H3O93FwLKQ
287: #2,o6F57TE1qgOCIZDu6dOS1JUS2K+Ma1pL,aWyekOAavnP30J1LjMyabQ
288: #2,134KqWcow3Gotvo7vQRB7GuIsZuHkNlK,PQXtcFybDCWJjmZzNsmNBg
289: #3,XZjtMRzywQ132+o1fIBM7lEhgHMIBcun,QwHh8axfX9b3O1aZVtnppQ
290: #3,za805qiDVRNqRk7pHaSjkQYQcy3eY/6e,v6hp+yOzem9Iyyv7mD1A0w
291: #3,g4Wah1WZyBCZsV3boNHIltWYoNHZuFGa,vqTDULwuwilPcCeJ8PBu4w
292: #3,9ZFJA5b39uYB9w4wUGxnaiv2UBPQc+uV,RXT3oNiFzHBEvBPJL7WNIQ
293: #3,RmfrKeyA+KNIYszgKcBpVp5bnhDJLrIu,jDooJK6UNABjEqTAazbCPw
294: #3,lhGdgMXagUmclhUV,ztNOKDCwtiLGZR2Syly+oA
295: #4,CYtEcUP40pZ/PkSDKBcNkWp8siY8RpPa,Pivu98789IuyHas9x7dEaw
296: #4,gvvHE5ICpgrPj4Lw7ttD0Lir4fFN2+id,PVw4bA+9zzT8qHg1sIDJ2w
297: #4,gQXZyNWZzBSZoRVV,sObdXXLTzTrB3ZhcJ56Hkw
298: #4,2o5ydT4GTQfJqcCihKPRV+9vVa2cmvf9,hFNeDq6OtjzCGpbmgY3SXQ
299: #4,oR53Eye8qP5MOdXuzKwGhrcsrkOMnAbQ,sX2i+IeO3ocE5ksZaxE/Vg
300: #4,0VUxgoJB1ISiRw7RfmVFIVp0uDV1BTjV,RVVgPI1yY5LwAXNXDG/qBw
301: