Playfair cipher: Difference between revisions

Content added Content deleted
m (→‎{{header|REXX}}: split some compound statements, added/changed whitespace and comments, ordered functions by name, used a template for the output sections.)
Line 2,088: Line 2,088:
<br>A fair amount of code was added to massage the decrypted encryption to remove doubled &nbsp; '''X'''es &nbsp; so as to match the original text
<br>A fair amount of code was added to massage the decrypted encryption to remove doubled &nbsp; '''X'''es &nbsp; so as to match the original text
<br>(this is the ''possible text'' part of the REXX code).
<br>(this is the ''possible text'' part of the REXX code).
<lang rexx>/*REXX program implements a PLAYFAIR cipher (encryption & decryption).*/
<lang rexx>/*REXX program implements a PLAYFAIR cipher (encryption and decryption). */
@abc='abcdefghijklmnopqrstuvwxyz'; @abcU=@abc /*lower and upper ABC's.*/
@abc= 'abcdefghijklmnopqrstuvwxyz'; @abcU= @abc /*literals for lower and upper ABC's.*/
parse arg omit key '(' text /*TEXT is the phrase to be used. */ ;oldK=key /*save old.*/
parse arg omit key '(' text /*TEXT is the phrase to be used. */
⚫
oldKey= key /*save the old key. */
if key =='' | key ==',' then do; key='Playfair example.'; oldK=key " ◄───using the default."; end
if omit=='' | omit==',' then omit='J' /*the "omitted" character. */
if key =='' | key ==',' then do; key= 'Playfair example.'
if text='' then text='Hide the gold in the tree stump!!' /*default.*/
oldKey= key " ◄───using the default."
newKey =scrub(key , 1) /*scrub old cipher key──► newKey */
end
newText=scrub(text ) /* " " text ──► newText*/
if omit=='' | omit==',' then omit= 'J' /*the "omitted" character string. */
if newText=='' then call err 'TEXT is empty or has no letters'
if text='' then text= 'Hide the gold in the tree stump!!' /*default.*/
newKey = scrub(key, 1) /*scrub old cipher key ──► newKey */
⚫
if length(omit)\==1 then call err 'OMIT letter must be only one letter'
newText= scrub(text ) /* " " text ──► newText */
if \datatype(omit,'M') then call err 'OMIT letter must be a Latin alphabet letter.'
upper omit @abcU /*uppercase OMIT char & alphabet.*/
if newText=='' then call err 'TEXT is empty or has no letters.'
⚫
if length(omit)\==1 then call err 'OMIT letter must be only one letter.'
⚫
cant='can''t contain the "OMIT" character: ' omit
if pos(omit,newText)\==0 then call err 'TEXT' cant
if \datatype(omit, 'M') then call err 'OMIT letter must be a Latin alphabet letter.'
⚫
upper omit @abcU /*uppercase OMIT characters & alphabet.*/
if pos(omit,newKey) \==0 then call err 'cipher key' cant
⚫
@cant= 'can''t contain the "OMIT" character: ' omit /*literal used in error text*/
⚫
fill=space(translate(@abcU,, omit), 0) /*elide OMIT char from alphabet. */
xx='X'; if omit==xx then xx='Q' /*char used for double characters*/
if pos(omit, newText)\==0 then call err 'TEXT' @cant
if length(newKey)<3 then call err 'cipher key is too short, must be ≥3 unique characters.'
if pos(omit, newKey) \==0 then call err 'cipher key' @cant
fill=space(translate(fill,,newKey),0) /*remove any cipher characters. */
fill= space( translate(@abcU, , omit), 0) /*elide OMIT characters from alphabet. */
grid=newKey || fill /*only first 25 chars are used.*/
xx= 'X' /*character used for double characters.*/
if omit==xx then xx= 'Q' /* " " " " " */
⚫
say 'old cipher key: ' strip(oldK) ; padL=14+2; pad=left('',padL)
if length(newKey)<3 then call err ,
⚫
say 'new cipher key: ' newKey ; padX=left('',padL,"═")'Playfair'
say ' omit char: ' omit /* [↓] lowercase of double char.*/
'cipher key is too short, must be ≥ 3 unique characters.'
⚫
fill= space( translate(fill, , newKey), 0) /*remove any cipher characters. */
say ' double char: ' xx ; Lxx=translate(xx, @abc, @abcU)
grid= newKey || fill /*only first 25 characters are used. */
⚫
say ' original text: ' strip(text) /* [↓] doubled version of Lxx. */
⚫
say 'old cipher key: ' strip(oldKey)
⚫
call show 'cleansed', newText ; LxxLxx=Lxx || Lxx
say 'new cipher key: ' newKey
⚫
#=0 /*number of grid characters used.*/
say ' omit char: ' omit
⚫
do row =1 for 5 /*build array of individual cells*/
say ' double char: ' xx
⚫
do col=1 for 5; #=#+1; @.row.col=substr(grid,#,1)
⚫
say ' original text: ' strip(text)
⚫
if row==1 then @.0.col=@.1.col
padL= 14 + 2
if col==5 then do; @.row.6=@.row.1; @.row.0=@.row.5; end
⚫
call show 'cleansed', newText
if row==5 then do; @.6.col=@.1.col; @.0.col=@.5.col; end
end /*col*/
#=0 /*number of grid characters used. */
end /*row*/
do row =1 for 5 /*build array of individual cells. */
⚫
do col=1 for 5; #= # + 1; @.row.col= substr(grid, #, 1)

⚫
if row==1 then @.0.col= @.1.col
⚫
eText=.Playfair(newText, 1); call show 'encrypted' , eText
pText=.Playfair(eText ); call show 'plain' , pText
if col==5 then do; @.row.6= @.row.1; @.row.0= @.row.5; end
⚫
if row==5 then do; @.6.col= @.1.col; @.0.col= @.5.col; end
⚫
qText=changestr(xx ||xx,pText,Lxx) /*change doubled doublechar─►sing*/
⚫
end /*col*/
⚫
qText=changestr(Lxx||xx,qText,LxxLxx) /*change Xx ──► lowercase dblChar*/
⚫
end /*row*/
⚫
qText=space(translate(qText,,xx),0) /*remove char used for "doubles."*/
pad = left('', padL)
⚫
upper qText /*reinstate the use of upperchars*/
⚫
padX= left('', padL, "═")'Playfair'
⚫
if length(qText)\==length(pText) then call show 'possible', qText
Lxx = translate(xx, @abc, @abcU) /* [↓] lowercase of double character. */
⚫
say ' original text: ' newText; say /*··· and show the original text.*/
LxxLxx= Lxx || Lxx /* [↓] doubled version of Lxx. */
⚫
eText= .Playfair(newText, 1); call show 'encrypted' , eText
pText= .Playfair(eText ); call show 'plain' , pText
⚫
qText= changestr(xx || xx, pText, Lxx) /*change doubled doublechar ──► single.*/
⚫
qText= changestr(Lxx || xx, qText, LxxLxx) /*change xx ──► lowercase dblCharacter*/
⚫
qText= space( translate( qText, , xx), 0) /*remove character used for "doubles". */
upper qText /*reinstate the use of upper characters*/
⚫
if length(qText)\==length(pText) then call show 'possible', qText
⚫
say ' original text: ' newText; say /*··· and also show the original text. */
if qtext==newText then say padx 'encryption──► decryption──► encryption worked.'
if qtext==newText then say padx 'encryption──► decryption──► encryption worked.'
exit /*stick a fork in it, we're done.*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
/*──────────────────────────────────one─line subroutines───────────────────────────────*/
@@: parse arg Xrow,Xcol; return @.Xrow.Xcol
@@: parse arg Xrow,Xcol; return @.Xrow.Xcol
err: say; say '***error!***' arg(1); say; exit 13
err: say; say '***error!***' arg(1); say; exit 13
LR: rowL=row(left(__,1)); colL=_; rowR=row(right(__,1)); colR=_; return length(__)
LR: rowL= row(left(__, 1)); colL= _; rowR= row(right(__,1)); colR= _; return length(__)
row: ?=pos(arg(1),grid); _=(?-1)//5+1; return (4+?)%5
row: ?= pos(arg(1), grid); _= (?-1) // 5 + 1; return (4+?) % 5
show: arg ,y; say; say right(arg(1) 'text: ',padL) digram(y); say pad space(y,0); return
show: arg ,y; say; say right(arg(1) 'text: ',padL) digram(y); say pad space(y, 0); return
/*──────────────────────────────────────────────────────────────────────────────────────*/
/*──────────────────────────────────SCRUB subroutine────────────────────*/
.Playfair: arg T,encrypt; i= -1; if encrypt==1 then i= 1; $=
⚫
scrub: procedure; arg xxx,unique; xxx=space(xxx,0) /*ARG caps all args*/
$=; do j=1 for length(xxx); _=substr(xxx,j,1)
do k=1 while i==1; _= substr(T, k, 1); if _==' ' then leave
if unique==1 then if pos(_,$)\==0 then iterate /*unique?*/
if _==substr(T, k+1, 1) then T= left(T, k) || Lxx || substr(T, k + 1)
if datatype(_,'M') then $=$||_ /*only use Latin letters. */
end /*k*/
end /*j*/
upper T
do j=1 by 2 to length(T); __= strip( substr(T, j, 2) )
⚫
return $
if LR()==1 then __= __ || xx; call LR /*append X or Q char, rule 1*/
/*──────────────────────────────────DIGRAM subroutine───────────────────*/
digram: procedure; parse arg x; $=; do j=1 by 2 to length(x)
select
$=$ || substr(x,j,2)' '
when rowL==rowR then __= @@(rowL, colL+i)@@(rowR, colR+i) /*rule 2*/
end /*j*/
when colL==colR then __= @@(rowL+i, colL )@@(rowR+i, colR) /*rule 3*/
⚫
otherwise __= @@(rowL, colR )@@(rowR, colL) /*rule 4*/
⚫
return strip($)
end /*select*/
/*──────────────────────────────────.PLAYFAIR subroutine────────────────*/
.Playfair: arg T,encrypt; i=-1; if encrypt==1 then i=1; $=
$= $ || __
do k=1 while i==1; _=substr(T,k,1); if _==' ' then leave
end /*j*/
⚫
return $
if _==substr(T,k+1 ,1) then T=left(T,k) || Lxx || substr(T,k+1)
/*──────────────────────────────────────────────────────────────────────────────────────*/
⚫
end /*k*/
digram: procedure; parse arg x; $=; do j=1 by 2 to length(x)
upper T
do j=1 by 2 to length(T); __=strip(substr(T,j,2))
$= $ || substr(x, j, 2)' '
if LR()==1 then __=__ || xx; call LR /*append X or Q char, rule 1*/
end /*j*/
⚫
return strip($)
select
/*──────────────────────────────────────────────────────────────────────────────────────*/
⚫
when rowL==rowR then __=@@(rowL, colL+i)@@(rowR, colR+i) /*rule 2*/
⚫
scrub: procedure; arg xxx,unique; xxx= space(xxx, 0) /*ARG capitalizes all args*/
when colL==colR then __=@@(rowL+i,colL )@@(rowR+i,colR) /*rule 3*/
otherwise __=@@(rowL, colR )@@(rowR, colL) /*rule 4*/
$=; do j=1 for length(xxx); _= substr(xxx, j, 1)
if unique==1 then if pos(_, $)\==0 then iterate /*is unique?*/
⚫
end /*select*/
if datatype(_, 'M') then $= $ || _ /*only use Latin letters. */
$=$ || __
end /*j*/
end /*j*/
return $</lang>
return $</lang>
Some older REXXes don't have a '''changestr''' bif, so one is included here ──► [[CHANGESTR.REX]].
Some older REXXes don't have a '''changestr''' bif, so one is included here ──► [[CHANGESTR.REX]].
<br><br>
<br><br>
'''output''' when using the default inputs:
{{out|output|text=&nbsp; when using the default inputs:}}
<pre>
<pre>
old cipher key: Playfair example. ◄───using the default.
old cipher key: Playfair example. ◄───using the default.
Line 2,192: Line 2,201:
════════════════Playfair encryption──► decryption──► encryption worked.
════════════════Playfair encryption──► decryption──► encryption worked.
</pre>
</pre>
'''output''' when using the input of: &nbsp; <tt> x stuvw (myteest </tt>
{{out|output|text=&nbsp; when using the input of: &nbsp; &nbsp; <tt> x &nbsp; stuvw &nbsp; (myteest </tt>}}
<pre>
<pre>
old cipher key: stuvw
old cipher key: stuvw
Retrieved from "https://rosettacode.org/wiki/Playfair_cipher"