File Coverage

blib/lib/TXTCOD.pm

Criterion	Covered	Total	%
statement	0	235	0.0
branch	0	70	0.0
condition	0	21	0.0
subroutine	0	6	0.0
pod	0	6	0.0
total	0	338	0.0

package TXTCOD;

=head1 NAME

   TXTCOD - Encoding module using the SAC system.

=head1 SYNOPSIS

   use TXTCOD;

   TXTCOD::codage($source,
                  $destination,
                  <$file.cod>,
                  <$algorithm.alc>,
                  <$param>);

   $param = TXTCOD::decodage($source,
                             $destination,
                             $file.cod,
                             <$algorithm.alc>);
   $file.cod = TXTCOD::createcod;

=head1 DESCRIPTION

   TXTCOD 4.7 encodes files with the SAC system, 2.4 version..
   The SAC system consists in several algorithms : a default algorithm who can be remplaced by user-written algorithms. Every algorithm uses a .cod file generated by the module and who contains a list of random numbers used by the module in order to ensure a maximal protection.
   B<< A file must be encoded with the same algorithm and the same .cod file !!! . >>
   This version of the SAC system can encode any type of file (binary files, text) and recognizes automatically their type.

   In the first part you will see the module's how-to and in the second part how to program an algorithm.

=head1 FIRST PART : TXTCOD Module

   These functions will be accessible after you have typed B<< use TXTCOD; >>


=head2 1) Encoding

   You call the encoding function by typing :
   TXTCOD::codage($source,
                  $destination,
                  <$file.cod>,
                  <$algorithm.alc>,
                  <$param>);
   This function doesn't return any value.

   $source is the file you want to encode.
   $destination is the file where TXTCOD will send the result of the encoding.
   These two parameters are B<< obligatory >>.

   $file.cod is the .cod file who is indispensable for the encoding and the decoding. If you don't specify this parameter, will search a "[year].cod" file, for example "2003.cod". A .cod file MUST be changed every year at least in order to assure an optimal protection.

   $algorithm.alc is the used algorithm. If you don't put anything, TXTCOD will use the default algorithm.

   $param is an user-defined parameter who won't be crypted.

=head2 2) Decoding

   You call the decoding function by typing :
   $param = TXTCOD::decodage($source,
                             $destination,
                             $file.cod,
                             <$algorithm.alc>);

   $source in the file you want to decode.
   $destination is the result of the decoding
   $file.cod et $algorithm.alc -> see the encoding function description.
   The returned value is the parameter you optionnally defined while the encoding and which isn't crypted.

=head2 3) .cod files creation

   To create a .cod file type :
   $file.cod = TXTCOD::createcod;
   The returned value is the file's name ("[year].cod")

=head1 SECOND PART : algorithms

   Writing an algorithm is simple : create a file ended by ".alc". This file will contain one-line commands who will tell the module the way to encode and decode your files.
=head2 1) encoding
  The first part of the file will contain the encoding algorithm.
  This algorithm will have a few variables :
      - X, each encoded letter
      - A,B,C,D,E,F,G,H,I,J, script-defined variables.
      - T,M,P  more secured variables
   There are many operators :
      - addition: "+"
      - subtraction: "-"
      - multiplication: "*"
      - division: "/"
      - power: "**"
   For example, we'll use the line : "X*(A+2)" in order to multiply the variable by (A+2). The compilation will be done internally by the module

=head2 2) decoding
   After the encoding part of the file, we will put a line containing only the word "end" without any blank or invisible character. After this word there is the decoding part. The variables of this part are the same thn in the first part.
   For example, if in the first part you put "X*(M+2)" you will type in the second part "X/(M+2)" in order to make the X variable becoming what she were before the encoding
   The root is done by this operation : for a "X**A" in the first part you will put "X**(1/A)" in the second.

=head2 3) comments
   You can comment your algorithm by any line beginning with a sharp #.
=head2 4) Notes
   You should not do operations who will make mubers (initial numbers up to 255) becoming too small or too big : perl will round the final numbers and the decoded letter will be very approximative.

=head1 TO DO

* increase the velocity of the users' algorithm which is REALLY slower than the default algorithm :(
* correct my poor english faults ;) and comment the script in english

=cut

$VERSION = 4.71;

sub codage{

$fic_sou = shift;#fichier source
$fic_dest = shift;#fichier de destination

$annee = (gmtime(time))[5] + 1900;#recherche de l'annŽe
$codingfile = shift;#fichier .cod
if(!$codingfile || $codingfile == "" || $codingfile == 0){
	$codingfile = "$annee.cod";
}

$algorithm = shift || "";

$is_binary = (-B $fic_sou) || 0;
$old_name = shift || $fic_sou;

open(FICSOU, "<", $fic_sou) || die "Error: $!";

if($is_binary == 1){ binmode FICSOU; } #le fichier est un fichier binaire

@text2conv = (); # initialisation du tableau général
my $buf;
while (sysread(FICSOU, $buf, 1024)){
	push @text2conv, $buf;  # lecture dans le fichier de lecture
}
close FICSOU;  # Fermeture du fichier de lecture

# encryptage

#****************CHARGEMENT DU SYSTEME DE CODAGE********************#
# Le script lit le fichier de codage spŽcifiŽ pour coder le fichier

open(CODINGFILE, "$codingfile");

$count = 1;

@codejours = ();
@codejourm = ();
@codemois = ();
$codeannee = 0;

foreach $x (){
	chomp($x);
	if($count <= 7){
		push @codejours, $x;
	}
	elsif($count <= 38){
		push @codejourm, $x;
	}
	elsif($count <= 50){
		push @codemois, $x;
	}
	elsif($count <= 51){
		$codeannee = $x;
	}
	$count++;
}

close CODINGFILE;

$jours = (gmtime(time))[6];
$jourm = (gmtime(time))[3];
$mois = (gmtime(time))[4];

$thiscodejours = $codejours[$jours];
$thiscodejourm = $codejourm[$jourm];
$thiscodemois = $codemois[$mois];
$thiscodeannee = $codeannee;

$nbrmodifcod1 = $thiscodejours + 1;
$nbrmodifcod2 = $thiscodejourm + 1;
$nbrmodifcod3 = int($thiscodemois / 100) + 1;
$nbrmodifcod4 = int($thiscodejourm / 9) + 1;
$nbrmodifcod5 = int($thiscodemois / 94) + 1;
$nbrmodifcod6 = int($thiscodeannee / 125) + 1;
$nbrmodifcod7 = int($thiscodejours + 3) + 1;
$nbrmodifcod8 = int($thiscodejourm + 13) + 1;
$nbrmodifcod9 = int($thiscodejours + 4) + 1;
$nbrmodifcod10 = int($thiscodeannee  + 73) + 1;


#*****************************SYSTEME DE CODAGE CHARGE*******************#
$time = time;
#***************************CHARGEMENT DE L'ALGORITHME*******************#
$algo = "";
unless($algorithm eq ""){
	open (ALGO, "$algorithm") || die "Algorithme $algorithm inexistant";
	foreach (){
		chomp;
		last if $_ eq "end";
		next if $_ =~ /^\#/;
		next if $_ eq "";
		$_ =~ s/X/(\$lettre)/gmo if $algo eq "";
		$_ =~ s/X/($algo)/gmo if $algo ne "";
		$_ =~ s/A/($nbrmodifcod1)/gmo;
		$_ =~ s/B/($nbrmodifcod2)/gmo;
		$_ =~ s/C/($nbrmodifcod3)/gmo;
		$_ =~ s/D/($nbrmodifcod4)/gmo;
		$_ =~ s/E/($nbrmodifcod5)/gmo;
		$_ =~ s/F/($nbrmodifcod6)/gmo;
		$_ =~ s/G/($nbrmodifcod7)/gmo;
		$_ =~ s/H/($nbrmodifcod8)/gmo;
		$_ =~ s/I/($nbrmodifcod9)/gmo;
		$_ =~ s/J/($nbrmodifcod10)/gmo;
		$_ =~ s/T/(\$phrs_cnt)/gmo;
		$_ =~ s/P/(\$mots_cnt)/gmo;
		$_ =~ s/M/(\$lettres_cnt)/gmo;
		$algo = $_;
	}
	close ALGO;
}

@mots = ();
@lettres = ();

$phrs_cnt = 1;
$mots_cnt = 1;
$lettres_cnt = 1;

@tout = ();
@total = ();


open(FICDEST, ">$fic_dest") || die "$!";
print FICDEST $jours. " " . $jourm . " " . $mois . " " . $annee . " " . $is_binary . " " . $old_name ."\n";

foreach $phr (@text2conv){
	$mots_cnt = 1;
	@mots = $phr =~ m/([\s|\S]{1,7})/gm;

	foreach $mot (@mots) {
		$lettres_cnt = 1;
		@lettres = split //, $mot;

		foreach $lettre (@lettres){
			$lettre = ord($lettre);
			if($algorithm eq ""){ &defcodalgo }
			else{
				$lettre = (eval $algo);
			}

			print FICDEST $lettre . "~"; # rentre le chiffre correspondant à la lettre et ~(signifiant la fin de lettre)
			$lettres_cnt++;
		}
		print FICDEST "|";
		$mots_cnt++;
	}
	print FICDEST "\n";
	$phrs_cnt++;
}#**************************************FIN SECONDE BOUCLE*********************************#

close FICDEST;

print ($time-time)/1000;

}  # fin codage

sub decodage{

$fic_sou = shift;#fichier source
$fic_dest = shift;#fichier de destination

open(FICSOU, $fic_sou) || die "Error: $!";
@text2conv = (); # initialisation du tableau général
$firstline = ;
foreach $line (){
	chomp($line);
	push @text2conv, $line;  # lecture dans le fichier de lecture
}
close FICSOU;  # Fermeture du fichier de lecture

chomp($firstline);
($jours, $jourm, $mois, $annee, $is_binary, $old_name) = split / /, $firstline;
$codingfile = shift;#fichier .cod
if(!$codingfile || $codingfile == "" || $codingfile == 0){
	$codingfile = "$annee.cod";
}

$algorithm = shift || "";

#****************CHARGEMENT DU SYSTEME DE DECODAGE********************#
# Le script lit le fichier de deccodage correspondant à l'année pour coder le fichier

open(CODINGFILE, "$codingfile") || die "Erreur (ouverture $codingfile): $!";

$count = 1;

@codejours = ();
@codejourm = ();
@codemois = ();
$codeannee = 0;

foreach $x (){
	chomp($x);
	if($count <= 7){
		push @codejours, $x;
	}
	elsif($count <= 38){
		push @codejourm, $x;
	}
	elsif($count <= 50){
		push @codemois, $x;
	}
	elsif($count <= 51){
		$codeannee = $x;
	}
	$count++;
}

close CODINGFILE;

$goodcodejours = $codejours[$jours];
$goodcodejourm = $codejourm[$jourm];
$goodcodemois = $codemois[$mois];
$goodcodeannee = $codeannee;

$nbrmodifdec1 = $goodcodejours + 1;
$nbrmodifdec2 = $goodcodejourm + 1;
$nbrmodifdec3 = int($goodcodemois / 100) + 1;
$nbrmodifdec4 = int($goodcodejourm / 9) + 1;
$nbrmodifdec5 = int($goodcodemois / 94) + 1;
$nbrmodifdec6 = int($goodcodeannee / 125) + 1;
$nbrmodifdec7 = int($goodcodejours + 3) + 1;
$nbrmodifdec8 = int($goodcodejourm + 13) + 1;
$nbrmodifdec9 = int($goodcodejours + 4) + 1;
$nbrmodifdec10 = int($goodcodeannee  + 73) + 1;
#*****************************SYSTEME DE DECODAGE CHARGE*******************#
#***************************CHARGEMENT DE L'ALGORITHME*******************#
$algo = ();
unless($algorithm eq ""){
	open (ALGO, "$algorithm") || die "Algorithme $algorithm inexistant";
	foreach (){
		chomp;
		$test = 2 if $test == 1;
		$test = 1 if $_ eq "end";
		next unless $test == 2;
		next if $_ =~ /^\#/;
		next if $_ eq "";
		$_ =~ s/X/(\$lettre)/gmo if $algo eq "";
		$_ =~ s/X/($algo)/gmo if $algo ne "";
		$_ =~ s/A/($nbrmodifdec1)/gmo;
		$_ =~ s/B/($nbrmodifdec2)/gmo;
		$_ =~ s/C/($nbrmodifdec3)/gmo;
		$_ =~ s/D/($nbrmodifdec4)/gmo;
		$_ =~ s/E/($nbrmodifdec5)/gmo;
		$_ =~ s/F/($nbrmodifdec6)/gmo;
		$_ =~ s/G/($nbrmodifdec7)/gmo;
		$_ =~ s/H/($nbrmodifdec8)/gmo;
		$_ =~ s/I/($nbrmodifdec9)/gmo;
		$_ =~ s/J/($nbrmodifdec10)/gmo;
		$_ =~ s/T/(\$phrs_cnt)/gmo;
		$_ =~ s/P/(\$mots_cnt)/gmo;
		$_ =~ s/M/(\$lettres_cnt)/gmo;
		$algo = $_;
	}
	close ALGO;
}


@mots = ();
@lettres = ();

$phrs_cnt = 1;
$mots_cnt = 1;
$lettres_cnt = 1;

# décryptage

$pourlesmots = ""; #pour stocker les lettres
@total = ();

open(FICDEST, ">", "$fic_dest");

if($is_binary == 1){ binmode FICDEST; } #le fichier est un fichier binaire

#**************************************BOUCLE UNIQUE: CHANGEMENTS LETTRE PAR LETTRE*********************************#
foreach $phr (@text2conv){
	$mots_cnt = 1;
	@mots = split /\|/, $phr;

	foreach $mot (@mots) {
		$lettres_cnt = 1;
		@lettres = split /\~/, $mot;

		foreach $lettre (@lettres){

			if($algorithm eq ""){ &defdecalgo }
			else{
				$lettre = (eval $algo);
			}

#**************************************TRANSFORMATION EN LETTRES*********************************#
			$lettre .= "!";
			chop $lettre;
			$lettre = chr($lettre);
			print FICDEST $lettre;
			$lettres_cnt++;
		}
		$mots_cnt++;
	}
	$phrs_cnt++;
}#**************************************FIN BOUCLE UNIQUE*********************************#

close FICDEST;

return $old_name;

}  # fin decodage

sub createcod{
	$file = (gmtime(time))[5]+1900 . ".cod";

	open (FILEOPENED, ">$file") || destructscript("Le fichier n'a pas pu être créé");
	for($a = 1;$a <= 7;$a++){

		print FILEOPENED int(rand(9) + 1), "\n" || destructscript("Le fichier ne peut pas être écrit");

	}

	for($a = 1;$a <= 31;$a++){

		print FILEOPENED int(rand(99) + 1), "\n" || destructscript("Le fichier ne peut pas être écrit");

	}

	for($a = 1;$a <= 12;$a++){

		print FILEOPENED int(rand(999) + 1), "\n" || destructscript("Le fichier ne peut pas être écrit");

	}

	print FILEOPENED int(rand(9999) + 1), "\n" || destructscript("Le fichier ne peut pas être écrit");

	sub destructscript{
		die "Erreur dans la création de fichier.cod: ", shift, " (erreur système: $!)";
	}

	close FILEOPENED;
	return $file;

}

sub defcodalgo{
	$lettre += $nbrmodifcod1;
	$lettre *= (($mots_cnt + 1) * $nbrmodifcod2);
	$lettre *= $nbrmodifcod3;
	$lettre *= $nbrmodifcod4;
	$lettre += (($lettres_cnt + 1) * $nbrmodifcod5);
	$lettre -= $nbrmodifcod6;
	$lettre *= $nbrmodifcod7;
	$lettre -= ($nbrmodifcod8 * ($phrs_cnt + 1));
	$lettre *= $nbrmodifcod9;
	$lettre -= $nbrmodifcod10;
}

sub defdecalgo{
	$lettre += $nbrmodifdec10;
	$lettre /= $nbrmodifdec9;
	$lettre += ($nbrmodifdec8 * ($phrs_cnt + 1));
	$lettre /= $nbrmodifdec7;
	$lettre += $nbrmodifdec6;
	$lettre -= (($lettres_cnt + 1) * $nbrmodifdec5);
	$lettre /= $nbrmodifdec4;
	$lettre /= $nbrmodifdec3;
	$lettre /= (($mots_cnt + 1) * $nbrmodifdec2);
	$lettre -= $nbrmodifdec1;
}

1;