INTEGER A$BUF(200) INTEGER KEYSTR(102),FILEN0(180) INTEGER KEY(64) INTEGER FD INTEGER MKTEMP,OPEN INTEGER ARG INTEGER GETARG INTEGER PARSCL INTEGER AAAAA0(14) DATA AAAAA0/229,188,230,190,228,188,230,190,235,188,242,243,190,0/ IF((PARSCL(AAAAA0,A$BUF).NE.-3))GOTO 10000 CALL ERROR('Usage: des (-e | -d) [ -k ] { }.') 10000 IF((A$BUF(229-225+1).EQ.0))GOTO 10003 IF((A$BUF(228-225+1).EQ.0))GOTO 10003 GOTO 10002 10003 IF((A$BUF(229-225+1).NE.0))GOTO 10004 IF((A$BUF(228-225+1).NE.0))GOTO 10004 GOTO 10002 10004 GOTO 10001 10002 CALL ERROR('Usage: des (-e | -d) [ -k ] { }.') 10001 IF((A$BUF(235-225+1).EQ.0))GOTO 10005 CALL EXPLO0(A$BUF(A$BUF(235-225+27)),KEY) GOTO 10006 10005 CALL PROMP0(KEYSTR) CALL EXPLO0(KEYSTR,KEY) 10006 IF((A$BUF(229-225+1).EQ.0))GOTO 10007 FD=MKTEMP(3) CALL GATHE0(FD) CALL ENCRZ0(FD,KEY,-11) CALL RMTEMP(FD) GOTO 10008 10007 IF((A$BUF(228-225+1).EQ.0))GOTO 10009 ARG=1 GOTO 10012 10010 ARG=ARG+(1) 10012 IF((GETARG(ARG,FILEN0,180).EQ.-1))GOTO 10011 FD=OPEN(FILEN0,1) IF((FD.NE.-3))GOTO 10013 CALL PUTLIN(FILEN0,-15) CALL REMARK(': can''t open.') GOTO 10014 10013 CALL DECRZ0(FD,KEY,-11) 10014 GOTO 10010 10011 IF((ARG.NE.1))GOTO 10015 CALL DECRZ0(-10,KEY,-11) 10015 CONTINUE 10009 CONTINUE 10008 CALL SWT END SUBROUTINE PROMP0(KEY) INTEGER KEY(102) INTEGER LWORD,LEN INTEGER DUPLX$,GETLIN,EQUAL INTEGER VALID0(102) INTEGER AAAAB0(13) INTEGER AAAAC0(30) DATA AAAAB0/197,238,244,229,242,160,235,229,249,186,160,160,0/ DATA AAAAC0/210,229,229,238,244,229,242,160,235,229,249,160,230,23 *9,242,160,246,225,236,233,228,225,244,233,239,238,186,160,160,0/ LWORD=DUPLX$(-1) CALL DUPLX$(:140000) CALL PUTLIN(AAAAB0,-15) LEN=GETLIN(KEY,-14) IF((LEN.NE.-1))GOTO 10016 CALL DUPLX$(LWORD) CALL ERROR('.') 10016 CALL PUTCH(138,-15) CALL PUTLIN(AAAAC0,-15) IF((GETLIN(VALID0,-14).NE.-1))GOTO 10017 CALL DUPLX$(LWORD) CALL ERROR('.') 10017 CALL PUTCH(138,-15) CALL DUPLX$(LWORD) IF((EQUAL(KEY,VALID0).NE.0))GOTO 10018 CALL ERROR('Keys do not match.') 10018 KEY(LEN)=0 RETURN END SUBROUTINE EXPLO0(KEYSTR,KEY) INTEGER KEYSTR(102) INTEGER KEY(64) INTEGER STR(102) INTEGER I,BP,MASK I=1 GOTO 10021 10019 I=I+(1) 10021 IF((KEYSTR(I).EQ.0))GOTO 10020 STR(I)=KEYSTR(I) GOTO 10019 10020 GOTO 10024 10022 I=I+(1) 10024 IF((I.GT.8))GOTO 10023 STR(I)=160 GOTO 10022 10023 BP=1 DO 10025 I=1,8 MASK=1 GOTO 10029 10027 MASK=LS(MASK,1) 10029 IF((MASK.GT.128))GOTO 10028 IF((AND(MASK,STR(I)).NE.0))GOTO 10030 KEY(BP)=0 GOTO 10031 10030 KEY(BP)=1 10031 BP=BP+(1) GOTO 10027 10028 CONTINUE 10025 CONTINUE 10026 RETURN END SUBROUTINE GATHE0(SCRAT0) INTEGER SCRAT0 INTEGER ARG,BUF(1024),NWR INTEGER READF,GETARG INTEGER FILEN0(180) INTEGER FD INTEGER OPEN INTEGER * 4 SIZE SIZE=0 CALL WRITEF(BUF,4,SCRAT0) ARG=1 GOTO 10034 10032 ARG=ARG+(1) 10034 IF((GETARG(ARG,FILEN0,180).EQ.-1))GOTO 10033 FD=OPEN(FILEN0,1) IF((FD.NE.-3))GOTO 10035 CALL PUTLIN(FILEN0,-15) CALL REMARK(': can''t open.') GOTO 10036 10035 CONTINUE 10037 NWR=READF(BUF,1024,FD) IF((NWR.NE.-1))GOTO 10038 GOTO 10039 10038 SIZE=SIZE+(NWR) CALL WRITEF(BUF,NWR,SCRAT0) GOTO 10037 10039 CALL CLOSE(FD) 10036 GOTO 10032 10033 IF((ARG.NE.1))GOTO 10040 10041 NWR=READF(BUF,1024,-10) IF((NWR.NE.-1))GOTO 10042 GOTO 10043 10042 SIZE=SIZE+(NWR) CALL WRITEF(BUF,NWR,SCRAT0) GOTO 10041 10043 CONTINUE 10040 CALL REWIND(SCRAT0) CALL WRITEF(SIZE,2,SCRAT0) CALL REWIND(SCRAT0) RETURN END SUBROUTINE ENCRZ0(IN,KEY,OUT) INTEGER IN,OUT INTEGER KEY(64) INTEGER KEYSC0(48,16),PLAIN(64),CIPHER(64) INTEGER BUF(4) INTEGER READF CALL COMPU0(KEY,KEYSC0) 10044 IF((READF(BUF,4,IN).EQ.-1))GOTO 10045 CALL UNPACK(64,BUF,PLAIN) CALL ENCRY0(PLAIN,CIPHER,KEYSC0) CALL PACK(64,CIPHER,BUF) CALL WRITEF(BUF,4,OUT) GOTO 10044 10045 RETURN END SUBROUTINE DECRZ0(IN,KEY,OUT) INTEGER IN,OUT INTEGER KEY(64) INTEGER KEYSC0(48,16),CIPHER(64),PLAIN(64) INTEGER BUF(4) INTEGER READF INTEGER * 4 SIZE CALL COMPU0(KEY,KEYSC0) IF((READF(BUF,4,IN).NE.-1))GOTO 10046 RETURN 10046 CALL UNPACK(64,BUF,CIPHER) CALL DECRY0(CIPHER,PLAIN,KEYSC0) CALL PACK(32,PLAIN,SIZE) 10047 IF((READF(BUF,4,IN).EQ.-1))GOTO 10048 CALL UNPACK(64,BUF,CIPHER) CALL DECRY0(CIPHER,PLAIN,KEYSC0) CALL PACK(64,PLAIN,BUF) IF((SIZE.LE.4))GOTO 10049 CALL WRITEF(BUF,4,OUT) GOTO 10050 10049 CALL WRITEF(BUF,INTS(SIZE),OUT) 10050 SIZE=SIZE-(4) GOTO 10047 10048 RETURN END SUBROUTINE COMPU0(KEY,KEYSC0) INTEGER KEY(64),KEYSC0(48,16) INTEGER C(28),D(28) INTEGER I,J,K,CCARRY,DCARRY INTEGER CSELE0(28),DSELE0(28),SHIFT0(16),KSELE0(48) DATA CSELE0/57,49,41,33,25,17,9,1,58,50,42,34,26,18,10,2,59,51,43, *35,27,19,11,3,60,52,44,36/ DATA DSELE0/63,55,47,39,31,23,15,7,62,54,46,38,30,22,14,6,61,53,45 *,37,29,21,13,5,28,20,12,4/ DATA SHIFT0/1,1,2,2,2,2,2,2,1,2,2,2,2,2,2,1/ DATA KSELE0/14,17,11,24,1,5,3,28,15,6,21,10,23,19,12,4,26,8,16,7,2 *7,20,13,2,41,52,31,37,47,55,30,40,51,45,33,48,44,49,39,56,34,53,46 *,42,50,36,29,32/ DO 10051 I=1,28 C(I)=KEY(CSELE0(I)) D(I)=KEY(DSELE0(I)) 10051 CONTINUE 10052 DO 10053 I=1,16 J=1 GOTO 10057 10055 J=J+(1) 10057 IF((J.GT.SHIFT0(I)))GOTO 10056 CCARRY=C(1) DCARRY=D(1) DO 10058 K=1,27 C(K)=C(K+1) D(K)=D(K+1) 10058 CONTINUE 10059 C(28)=CCARRY D(28)=DCARRY GOTO 10055 10056 DO 10060 J=1,48 IF((KSELE0(J).GT.28))GOTO 10062 KEYSC0(J,I)=C(KSELE0(J)) GOTO 10063 10062 KEYSC0(J,I)=D(KSELE0(J)-28) 10063 CONTINUE 10060 CONTINUE 10061 CONTINUE 10053 CONTINUE 10054 RETURN END SUBROUTINE INITI0(TEXT,LEFT,RIGHT) INTEGER TEXT(64),LEFT(32),RIGHT(32) INTEGER I INTEGER LSELE0(32),RSELE0(32) DATA LSELE0/58,50,42,34,26,18,10,2,60,52,44,36,28,20,12,4,62,54,46 *,38,30,22,14,6,64,56,48,40,32,24,16,8/ DATA RSELE0/57,49,41,33,25,17,9,1,59,51,43,35,27,19,11,3,61,53,45, *37,29,21,13,5,63,55,47,39,31,23,15,7/ DO 10064 I=1,32 LEFT(I)=TEXT(LSELE0(I)) RIGHT(I)=TEXT(RSELE0(I)) 10064 CONTINUE 10065 RETURN END SUBROUTINE INVER0(LEFT,RIGHT,TEXT) INTEGER LEFT(32),RIGHT(32),TEXT(64) INTEGER I INTEGER TSELE0(64) DATA TSELE0/40,8,48,16,56,24,64,32,39,7,47,15,55,23,63,31,38,6,46, *14,54,22,62,30,37,5,45,13,53,21,61,29,36,4,44,12,52,20,60,28,35,3, *43,11,51,19,59,27,34,2,42,10,50,18,58,26,33,1,41,9,49,17,57,25/ DO 10066 I=1,64 IF((TSELE0(I).GT.32))GOTO 10068 TEXT(I)=LEFT(TSELE0(I)) GOTO 10069 10068 TEXT(I)=RIGHT(TSELE0(I)-32) 10069 CONTINUE 10066 CONTINUE 10067 RETURN END SUBROUTINE PACK(BITS,SOURCE,DEST) INTEGER BITS,DEST(1) INTEGER SOURCE(1) INTEGER SI,DI,MASK DI=0 MASK=0 SI=1 GOTO 10072 10070 SI=SI+(1) 10072 IF((SI.GT.BITS))GOTO 10071 IF((MASK.NE.0))GOTO 10073 MASK=:100000 DI=DI+(1) DEST(DI)=0 10073 IF((SOURCE(SI).EQ.0))GOTO 10074 DEST(DI)=OR(DEST(DI),MASK) 10074 MASK=RS(MASK,1) GOTO 10070 10071 RETURN END SUBROUTINE UNPACK(BITS,SOURCE,DEST) INTEGER BITS,SOURCE(1) INTEGER DEST(1) INTEGER SI,DI,MASK SI=0 MASK=0 DI=1 GOTO 10077 10075 DI=DI+(1) 10077 IF((DI.GT.BITS))GOTO 10076 IF((MASK.NE.0))GOTO 10078 SI=SI+(1) MASK=:100000 10078 IF((AND(MASK,SOURCE(SI)).EQ.0))GOTO 10079 DEST(DI)=1 GOTO 10080 10079 DEST(DI)=0 10080 MASK=RS(MASK,1) GOTO 10075 10076 RETURN END C ---- Long Name Map ---- C initialpermutation initi0 C cselect csele0 C dselect dsele0 C encryptchunk encry0 C filename filen0 C kselect ksele0 C lselect lsele0 C gatherplaintext gathe0 C rselect rsele0 C tselect tsele0 C keysched keysc0 C decrypt decrz0 C validation valid0 C inverseinitialpermutation inver0 C promptforkey promp0 C cipherfunction ciphe0 C computekeyschedule compu0 C shiftamount shift0 C scratchfile scrat0 C encrypt encrz0 C explodekey explo0 C decryptchunk decry0