Mensajes auto-descifrables

Uno de los problemas cuando se cifra un mensaje es que para descifrarlo se necesita el mismo programa que se utilizo para cifrarlo. Imaginemos por ejemplo la siguiente situación, yo cifro un mensaje y quiero enviárselo a un amigo, pero mientras yo uso Windows mi amigo utiliza Linux así que se nos plantea el problema de encontrar una aplicación que funcione en ambos sistemas operativos, y aun podemos darle otra vuelta de tuerca mas, imaginemos ahora que yo quiero cifrar un mensaje en mi PC pero leerlo desde mi móvil con Android, volvemos a tener el mismo problema.

En este ultimo caso es donde me encontraba yo, necesitaba un programa que me permitiera cifrar mensajes que luego pudiera ver en mi móvil con Andoid. Entonces se me ocurrió que podía crear una pequeña aplicación que cifrara los mensaje utilizando dos algoritmos robustos como son AES y SHA256, pero que en vez vez de devolver simplemente el mensaje cifrado devolviera el código fuente de otro programa, con el mensaje cifrado incluido dentro, capaz de descifrar el mensaje si introducimos la contraseña correcta.

Para explicarlo un poco mejor vamos a volver a imaginarlos las situación del principio. Imaginemos que ciframos un mensaje en Windows utilizando este programa, el resultado sera un archivo .PAS con el código fuente del programa de "descifrado", entonces se lo envió a mi amigo, el que usa Linux, y el solo tendrá que utilizar alguno de los multiples compiladores de Pascal para Linux para compilar el código y descifrar el mensaje.

El código fuente que se genera es intencionadamente sencillo (aunque robusto), lo que permite que se pueda compilar en diferentes plataformas, incluso en procesadores ARM como los que tienen los teléfonos móviles con Android. Así que solo necesitamos un compilador de Pascal para esta plataforma y listo. Yo recomiendo freepascal, o aun mas simple la aplicación PascalGUI (basada en freepascal) que se puede descargar desde la tienda de Android.

El programa con el código fuente se puede descargar de aquí:
http://delphi.jmrds.com/sites/delphi.jmrds.com/adjuntos/SelfDecrypt.zip

El ejecutable solo necesita tener el archivo "SelfDecrypt.dat" en la misma carpeta para funcionar, el resto de ficheros son el código fuente del programa.

El código que utilizo como "plantilla" es el siguiente:

program $NOMBREPROGRAMA$;
 
{$APPTYPE CONSOLE}
 
uses Sysutils;
 
type
  TSHA256HASH = array[0..7] of Cardinal;
  PSHA256HASH = ^TSHA256HASH;
  TChunk = array[0..15] of Cardinal;
  PChunk = ^TChunk;
 
  TAESState = Array[0..3,0..3] of Byte;
  TAESKey = Array[0..7] of Cardinal;
  TAESExpandedKey = Array[0..59] of Cardinal;
 
const
  $MENSAJECIFRADO$  
 
  k: array[0..63] of Cardinal = (
   $428a2f98, $71374491, $b5c0fbcf, $e9b5dba5, $3956c25b, $59f111f1, $923f82a4, $ab1c5ed5,
   $d807aa98, $12835b01, $243185be, $550c7dc3, $72be5d74, $80deb1fe, $9bdc06a7, $c19bf174,
   $e49b69c1, $efbe4786, $0fc19dc6, $240ca1cc, $2de92c6f, $4a7484aa, $5cb0a9dc, $76f988da,
   $983e5152, $a831c66d, $b00327c8, $bf597fc7, $c6e00bf3, $d5a79147, $06ca6351, $14292967,
   $27b70a85, $2e1b2138, $4d2c6dfc, $53380d13, $650a7354, $766a0abb, $81c2c92e, $92722c85,
   $a2bfe8a1, $a81a664b, $c24b8b70, $c76c51a3, $d192e819, $d6990624, $f40e3585, $106aa070,
   $19a4c116, $1e376c08, $2748774c, $34b0bcb5, $391c0cb3, $4ed8aa4a, $5b9cca4f, $682e6ff3,
   $748f82ee, $78a5636f, $84c87814, $8cc70208, $90befffa, $a4506ceb, $bef9a3f7, $c67178f2);
 
  Sbox: Array[0..255] of Byte = (
    $63,$7c,$77,$7b,$f2,$6b,$6f,$c5,$30,$01,$67,$2b,$fe,$d7,$ab,$76,
    $ca,$82,$c9,$7d,$fa,$59,$47,$f0,$ad,$d4,$a2,$af,$9c,$a4,$72,$c0,
    $b7,$fd,$93,$26,$36,$3f,$f7,$cc,$34,$a5,$e5,$f1,$71,$d8,$31,$15,
    $04,$c7,$23,$c3,$18,$96,$05,$9a,$07,$12,$80,$e2,$eb,$27,$b2,$75,
    $09,$83,$2c,$1a,$1b,$6e,$5a,$a0,$52,$3b,$d6,$b3,$29,$e3,$2f,$84,
    $53,$d1,$00,$ed,$20,$fc,$b1,$5b,$6a,$cb,$be,$39,$4a,$4c,$58,$cf,
    $d0,$ef,$aa,$fb,$43,$4d,$33,$85,$45,$f9,$02,$7f,$50,$3c,$9f,$a8,
    $51,$a3,$40,$8f,$92,$9d,$38,$f5,$bc,$b6,$da,$21,$10,$ff,$f3,$d2,
    $cd,$0c,$13,$ec,$5f,$97,$44,$17,$c4,$a7,$7e,$3d,$64,$5d,$19,$73,
    $60,$81,$4f,$dc,$22,$2a,$90,$88,$46,$ee,$b8,$14,$de,$5e,$0b,$db,
    $e0,$32,$3a,$0a,$49,$06,$24,$5c,$c2,$d3,$ac,$62,$91,$95,$e4,$79,
    $e7,$c8,$37,$6d,$8d,$d5,$4e,$a9,$6c,$56,$f4,$ea,$65,$7a,$ae,$08,
    $ba,$78,$25,$2e,$1c,$a6,$b4,$c6,$e8,$dd,$74,$1f,$4b,$bd,$8b,$8a,
    $70,$3e,$b5,$66,$48,$03,$f6,$0e,$61,$35,$57,$b9,$86,$c1,$1d,$9e,
    $e1,$f8,$98,$11,$69,$d9,$8e,$94,$9b,$1e,$87,$e9,$ce,$55,$28,$df,
    $8c,$a1,$89,$0d,$bf,$e6,$42,$68,$41,$99,$2d,$0f,$b0,$54,$bb,$16
  );
 
  InvSbox: Array[0..255] of Byte = (
    $52,$09,$6a,$d5,$30,$36,$a5,$38,$bf,$40,$a3,$9e,$81,$f3,$d7,$fb,
    $7c,$e3,$39,$82,$9b,$2f,$ff,$87,$34,$8e,$43,$44,$c4,$de,$e9,$cb,
    $54,$7b,$94,$32,$a6,$c2,$23,$3d,$ee,$4c,$95,$0b,$42,$fa,$c3,$4e,
    $08,$2e,$a1,$66,$28,$d9,$24,$b2,$76,$5b,$a2,$49,$6d,$8b,$d1,$25,
    $72,$f8,$f6,$64,$86,$68,$98,$16,$d4,$a4,$5c,$cc,$5d,$65,$b6,$92,
    $6c,$70,$48,$50,$fd,$ed,$b9,$da,$5e,$15,$46,$57,$a7,$8d,$9d,$84,
    $90,$d8,$ab,$00,$8c,$bc,$d3,$0a,$f7,$e4,$58,$05,$b8,$b3,$45,$06,
    $d0,$2c,$1e,$8f,$ca,$3f,$0f,$02,$c1,$af,$bd,$03,$01,$13,$8a,$6b,
    $3a,$91,$11,$41,$4f,$67,$dc,$ea,$97,$f2,$cf,$ce,$f0,$b4,$e6,$73,
    $96,$ac,$74,$22,$e7,$ad,$35,$85,$e2,$f9,$37,$e8,$1c,$75,$df,$6e,
    $47,$f1,$1a,$71,$1d,$29,$c5,$89,$6f,$b7,$62,$0e,$aa,$18,$be,$1b,
    $fc,$56,$3e,$4b,$c6,$d2,$79,$20,$9a,$db,$c0,$fe,$78,$cd,$5a,$f4,
    $1f,$dd,$a8,$33,$88,$07,$c7,$31,$b1,$12,$10,$59,$27,$80,$ec,$5f,
    $60,$51,$7f,$a9,$19,$b5,$4a,$0d,$2d,$e5,$7a,$9f,$93,$c9,$9c,$ef,
    $a0,$e0,$3b,$4d,$ae,$2a,$f5,$b0,$c8,$eb,$bb,$3c,$83,$53,$99,$61,
    $17,$2b,$04,$7e,$ba,$77,$d6,$26,$e1,$69,$14,$63,$55,$21,$0c,$7d
  );
 
  LogTable: Array[0..255] of Byte = (
    $00,$ff,$c8,$08,$91,$10,$d0,$36,$5a,$3e,$d8,$43,$99,$77,$fe,$18,
    $23,$20,$07,$70,$a1,$6c,$0c,$7f,$62,$8b,$40,$46,$c7,$4b,$e0,$0e,
    $eb,$16,$e8,$ad,$cf,$cd,$39,$53,$6a,$27,$35,$93,$d4,$4e,$48,$c3,
    $2b,$79,$54,$28,$09,$78,$0f,$21,$90,$87,$14,$2a,$a9,$9c,$d6,$74,
    $b4,$7c,$de,$ed,$b1,$86,$76,$a4,$98,$e2,$96,$8f,$02,$32,$1c,$c1,
    $33,$ee,$ef,$81,$fd,$30,$5c,$13,$9d,$29,$17,$c4,$11,$44,$8c,$80,
    $f3,$73,$42,$1e,$1d,$b5,$f0,$12,$d1,$5b,$41,$a2,$d7,$2c,$e9,$d5,
    $59,$cb,$50,$a8,$dc,$fc,$f2,$56,$72,$a6,$65,$2f,$9f,$9b,$3d,$ba,
    $7d,$c2,$45,$82,$a7,$57,$b6,$a3,$7a,$75,$4f,$ae,$3f,$37,$6d,$47,
    $61,$be,$ab,$d3,$5f,$b0,$58,$af,$ca,$5e,$fa,$85,$e4,$4d,$8a,$05,
    $fb,$60,$b7,$7b,$b8,$26,$4a,$67,$c6,$1a,$f8,$69,$25,$b3,$db,$bd,
    $66,$dd,$f1,$d2,$df,$03,$8d,$34,$d9,$92,$0d,$63,$55,$aa,$49,$ec,
    $bc,$95,$3c,$84,$0b,$f5,$e6,$e7,$e5,$ac,$7e,$6e,$b9,$f9,$da,$8e,
    $9a,$c9,$24,$e1,$0a,$15,$6b,$3a,$a0,$51,$f4,$ea,$b2,$97,$9e,$5d,
    $22,$88,$94,$ce,$19,$01,$71,$4c,$a5,$e3,$c5,$31,$bb,$cc,$1f,$2d,
    $3b,$52,$6f,$f6,$2e,$89,$f7,$c0,$68,$1b,$64,$04,$06,$bf,$83,$38
  );
 
  InvLogTable: Array[0..255] of Byte = (
    $01,$e5,$4c,$b5,$fb,$9f,$fc,$12,$03,$34,$d4,$c4,$16,$ba,$1f,$36,
    $05,$5c,$67,$57,$3a,$d5,$21,$5a,$0f,$e4,$a9,$f9,$4e,$64,$63,$ee,
    $11,$37,$e0,$10,$d2,$ac,$a5,$29,$33,$59,$3b,$30,$6d,$ef,$f4,$7b,
    $55,$eb,$4d,$50,$b7,$2a,$07,$8d,$ff,$26,$d7,$f0,$c2,$7e,$09,$8c,
    $1a,$6a,$62,$0b,$5d,$82,$1b,$8f,$2e,$be,$a6,$1d,$e7,$9d,$2d,$8a,
    $72,$d9,$f1,$27,$32,$bc,$77,$85,$96,$70,$08,$69,$56,$df,$99,$94,
    $a1,$90,$18,$bb,$fa,$7a,$b0,$a7,$f8,$ab,$28,$d6,$15,$8e,$cb,$f2,
    $13,$e6,$78,$61,$3f,$89,$46,$0d,$35,$31,$88,$a3,$41,$80,$ca,$17,
    $5f,$53,$83,$fe,$c3,$9b,$45,$39,$e1,$f5,$9e,$19,$5e,$b6,$cf,$4b,
    $38,$04,$b9,$2b,$e2,$c1,$4a,$dd,$48,$0c,$d0,$7d,$3d,$58,$de,$7c,
    $d8,$14,$6b,$87,$47,$e8,$79,$84,$73,$3c,$bd,$92,$c9,$23,$8b,$97,
    $95,$44,$dc,$ad,$40,$65,$86,$a2,$a4,$cc,$7f,$ec,$c0,$af,$91,$fd,
    $f7,$4f,$81,$2f,$5b,$ea,$a8,$1c,$02,$d1,$98,$71,$ed,$25,$e3,$24,
    $06,$68,$b3,$93,$2c,$6f,$3e,$6c,$0a,$b8,$ce,$ae,$74,$b1,$42,$b4,
    $1e,$d3,$49,$e9,$9c,$c8,$c6,$c7,$22,$6e,$db,$20,$bf,$43,$51,$52,
    $66,$b2,$76,$60,$da,$c5,$f3,$f6,$aa,$cd,$9a,$a0,$75,$54,$0e,$01
  );  
 
function ror(x: Cardinal; y: Byte): Cardinal;
begin
  ror:=
    (x shr y) +
    (x shl (32-y));
end;
 
function bswap(x: Cardinal): Cardinal;
begin
  bswap:=
    ((x and $000000FF) shl 24) +
    ((x and $0000FF00) shl  8) +
    ((x and $00FF0000) shr  8) +
    ((x and $FF000000) shr 24);
end;
 
 
function swap64(x: int64): int64;
begin
  swap64:=
    ((x and $00000000000000FF) shl 56) +
    ((x and $000000000000FF00) shl 40) +
    ((x and $0000000000FF0000) shl 24) +
    ((x and $00000000FF000000) shl 8) +
    ((x and $000000FF00000000) shr 8) +
    ((x and $0000FF0000000000) shr 24) +
    ((x and $00FF000000000000) shr 40) +
    ((x and $FF00000000000000) shr 56);
end;
 
function CalcChunk(Hash: TSHA256HASH; var Chunk: TChunk): TSHA256HASH;
var
  i: Integer;
  s0, s1, maj, t1, t2, ch: Cardinal;
  w: array[0..63] of Cardinal;
begin
  for i:=0 to 15 do
    w[i]:= bswap(Chunk[i]);
  for i:= 16 to 63 do
  begin
    s0:=   ror(w[i-15],7) xor ror(w[i-15],18) xor (w[i-15] shr 3);
    s1:=   ror(w[i-2],17) xor ror(w[i-2],19) xor (w[i-2] shr 10);
    w[i]:= w[i-16] + s0 + w[i-7] + s1;
  end;
  for i:= 0 to 63 do
  begin
    s0:=  ror(Hash[0],2) xor ror(Hash[0],13) xor ror(Hash[0],22);
    maj:= (Hash[0] and Hash[1]) xor (Hash[0] and Hash[2]) xor (Hash[1] and Hash[2]);
    t2:=  s0 + maj;
    s1:=  ror(Hash[4],6) xor ror(Hash[4],11) xor ror(Hash[4],25);
    ch:=  (Hash[4] and Hash[5]) xor ((not Hash[4]) and Hash[6]);
    t1:=  Hash[7] + s1 + ch + k[i] + w[i];
    Hash[7]:= Hash[6];
    Hash[6]:= Hash[5];
    Hash[5]:= Hash[4];
    Hash[4]:= Hash[3] + t1;
    Hash[3]:= Hash[2];
    Hash[2]:= Hash[1];
    Hash[1]:= Hash[0];
    Hash[0]:= t1 + t2;
  end;
  CalcChunk:= Hash;
end;
 
function CalcSHA256(Msg: AnsiString): TSHA256HASH;
var
  i,j,k: Integer;
  Size: int64;
  P: PAnsiChar;
  Chunk: PChunk;
  H: TSHA256HASH;
  Res: TSHA256HASH;
begin
  Res[0]:= $6a09e667;
  Res[1]:= $bb67ae85;
  Res[2]:= $3c6ef372;
  Res[3]:= $a54ff53a;
  Res[4]:= $510e527f;
  Res[5]:= $9b05688c;
  Res[6]:= $1f83d9ab;
  Res[7]:= $5be0cd19;
  Size:= Length(Msg);
  i:= Size + 9;
  if i mod 64 > 0 then
   inc(i,64 - (i mod 64));
  GetMem(P,i);
  FillChar(P^,i,#0);
  StrCopy(P,PAnsiChar(Msg));
  P[Size]:= #$80;
  Size:= swap64(Size*8);
  move(Size,P[i-8],8);
  Chunk:= PChunk(P);
  for j:= 1 to i div 64 do
  begin
    H:= CalcChunk(Res,Chunk^);
    for k:= 0 to 7 do
      Res[k]:= Res[k] + H[k];
    inc(Chunk);
  end;
  FreeMem(P);
  CalcSHA256:= Res;
end;
 
procedure InvSubBytes(var State: TAESState);
var
  i,j: Integer;
begin
  for i:= 0 to 3 do
    for j:= 0 to 3 do
      State[i,j]:= InvSbox[State[i,j]];
end;
 
procedure InvShiftRows(var State: TAESState);
var
  i,j,k: Integer;
begin
  for j:= 1 to 3 do
    for i:= j downto 1 do
    begin
      k:= State[3,j];
      State[3,j]:= State[2,j];
      State[2,j]:= State[1,j];
      State[1,j]:= State[0,j];
      State[0,j]:= k;
    end;
end;
 
function Mult(X, Y: Byte): Byte;
begin
  if (X = 0) or (Y = 0) then
    Mult:= 0
  else
    Mult:= InvLogTable[(LogTable[X] + LogTable[Y]) mod $FF];
end;
 
procedure InvMixColumns(var State: TAESState);
var
  i,j: Integer;
  m: Array[0..3] of Byte;
begin
  for i:= 0 to 3 do
  begin
    for j:= 0 to 3 do
      m[j]:= State[i,j];
    State[i,0]:=
      Mult($0e,m[0]) XOR Mult($0b,m[1]) XOR Mult($0d,m[2]) XOR Mult($09,m[3]);
    State[i,1]:=
      Mult($09,m[0]) XOR Mult($0e,m[1]) XOR Mult($0b,m[2]) XOR Mult($0d,m[3]);
    State[i,2]:=
      Mult($0d,m[0]) XOR Mult($09,m[1]) XOR Mult($0e,m[2]) XOR Mult($0b,m[3]);
    State[i,3]:=
      Mult($0b,m[0]) XOR Mult($0d,m[1]) XOR Mult($09,m[2]) XOR Mult($0e,m[3]);
  end;
end;
 
procedure AddRoundKey(var State: TAESState; ExpandedKey: TAESExpandedKey;
  Round: Integer);
var
  i: Integer;
  W: Cardinal;
begin
  for i:= 0 to 3 do
  begin
    W:= ExpandedKey[(Round * 4) + i];
    State[i,0]:= State[i,0] XOR ((W shr 24) and $FF);
    State[i,1]:= State[i,1] XOR ((W shr 16) and $FF);
    State[i,2]:= State[i,2] XOR ((W shr 8) and $FF);
    State[i,3]:= State[i,3] XOR (W and $FF);
  end;
end;
 
function SubWord(W: Cardinal): Cardinal;
begin
  SubWord:= (Sbox[W shr 24] shl 24) or (Sbox[(W shr 16) and $FF] shl 16) or
    (Sbox[(W shr 8) and $FF] shl 8) or Sbox[W and $FF];
end;
 
function RotWord(W: Cardinal): Cardinal;
begin
  RotWord:= (W shl 8) or (W shr 24);
end;
 
function RCon(n: Integer): Cardinal;
var
  Res: Cardinal;
begin
  Res:= 1;
  if n = 0 then
    Res:= 0
  else while n > 1 do
  begin
    Res:= Mult(Res,2);
    dec(n);
  end;
  RCon:= Res shl 24;
end;
 
procedure AESExpandKey(var ExpandedKey: TAESExpandedKey; Key: TAESKey);
var
  i: Integer;
  Temp: Cardinal;
begin
  FillChar(ExpandedKey,Sizeof(ExpandedKey),#0);
  for i:= 0 to 7 do
    ExpandedKey[i]:= Key[i];
  for i:= 8 to 59 do
  begin
    Temp:= ExpandedKey[i-1];
    if (i mod 8 = 0) then
      Temp:= SubWord(RotWord(Temp)) XOR Rcon(i div 8)
    else if (i mod 8 = 4) then
      Temp:= SubWord(temp);
    ExpandedKey[i]:= ExpandedKey[i-8] XOR Temp;
  end;
end;
 
procedure AESDecrypt(var State: TAESState; ExpandedKey: TAESExpandedKey);
var
  Round: Integer;
begin
  AddRoundKey(State,ExpandedKey,14);
  for Round:= 13 downto 1 do
  begin
    InvShiftRows(State);
    InvSubBytes(State);
    AddRoundKey(State,ExpandedKey,Round);
    InvMixColumns(State);
  end;
  InvShiftRows(State);
  InvSubBytes(State);
  AddRoundKey(state,ExpandedKey,0);
end;
 
procedure XORState(var S1: TAESState; S2: TAESState);
var
  i,j: Integer;
begin
  for i:= 0 to 3 do
    for j:= 0 to 3 do
      S1[i,j]:= S1[i,j] XOR S2[i,j];
end;
 
var
  i: Integer;
  Clave: String;
  Key: TAESKey;
  ExpandedKey: TAESExpandedKey;
  State: TAESState;
begin
  Writeln;
  Write('Clave: ');
  Readln(Clave);
  TSHA256HASH(Key):= CalcSHA256(Clave);
  AESExpandKey(ExpandedKey,Key);
  for i:= Low(T) to High(T) do
  begin
    State:= T[i];
    AESDecrypt(State,ExpandedKey);
    if i > Low(T) then
      XORState(State,T[i-1]);
    Write(PAnsiChar(@State));
  end;
  Writeln;
  Write('Pulsa enter para salir ...');
  Readln;
end.

Enlaces de interes:
Cifrado AES-256 - http://delphi.jmrds.com/node/31
Calcular el hash SHA256 de un texto - http://delphi.jmrds.com/node/64

Comentarios

Esta es una excelente idea, que puede tener muchas practicas aplicaciones.

¡Otro artículo para los marcadores! Por favor, Domingo, a ver si puedes dar un respiro al personal, que, ¡no hay quien te siga, hombre! Muchas gracias otra vez. Clic. Ya está. ;-)