CS260 (Fortran) final project... for teh lulz

crypto.f95

! dug up this old thing from an old college class... i had a few good chuckles

!--------------------------------------------------------------------------
!  TITLE: CSCI260  Final Project
!  AUTHORS: 
!	* kisom
!	* Chris
!	* Laura
!
!  CLASS:  CSCI260A
!  DATE WRITTEN: TODAY
!  LAST REVISION: TODAY
!  DESCRIPTION: Symmetric key stream cipher cryptosystem
!  VARIABLES USED:
!	NAME:		LOCATION:	TYPE:		COMMENT:
!	c_menu		SUB MENU	character	Holds user choice for 
!                                                       menu
!			SUB CRYPT_MENU	
!	key(16)		SUB GENKEY	character	Holds generated key
!	e_key		SUB GENKEY	integer		Key element - randomly 
!                                                       generated ASCII code for 
!                                                       single element of key 
!                                                       character array
!	rng_r		SUB GENKEY	real		random number generator 
!                                                       result, used in the key 
!                                                       generation
!	
!
!
!---------------------------------------------------------------------------

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! CRYPTO.F95						   !
! symmetric key stream cipher encryption program	   !
! 	This is a FORTRAN software solution to the confi-  !
!	dentiality problem in information security. This   !
!	solution is fairly weak in its implementation and  !
! 	unlike many other excellent cryptographic suites   !
!	available, does not address the integrity, authen- !
!	ticity, or non-repudiation problems. Random number !
!	generation in FORTRAN also presents another problem!
!	as this team has not yet determined the source of  !
!	entropy in the FORTRAN random number generator,	   !
!	therefore this program cannot guarantee the use of !
!	cryptographically secure or strong random numbers. !
!							   !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!



PROGRAM crypto
	IMPLICIT NONE
	
	! variable declarations
	
	
	! call the main menu, loop forever (SUB MENU will end the program at
	! the appointed hour)
	CALL RANDOM_SEED
	DO
		CALL MENU( )
	END DO
	
	! End program
	!	note that menu should end the program, but this is here as a 
	!	sanity check.
	
	STOP
	

CONTAINS


!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! SUB MENU                                                 !
! primary menu subroutine for the program      		   !
!	this subroutine will run in a loop continuously    !
!	until the user decides to quit. Note that the      !
!	program is to be halted here rather than the main  !
!	program body.                          		   !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

SUBROUTINE MENU( )

	! variable definition
	CHARACTER(len=1):: c_menu
	
	WRITE(*,*) "CSCI260 SIMPLE ENCRYPTOR"
	WRITE(*,*) "========================"
	WRITE(*,*) ""
	WRITE(*,*) "Select a choice from the menu: "
	WRITE(*,*) "(G)enerate new key"
	WRITE(*,*) "(A)pply key to keyboard input (encrypt or decrypt text)"
	WRITE(*,*) "(Q)uit program"
	WRITE(*,*) ""
	WRITE(*,*) "Choice: "
	READ(*,*) c_menu
	
	IF ((c_menu == 'G') .OR. (c_menu == 'g')) CALL GENKEY()
	IF ((c_menu == 'A') .OR. (c_menu == 'a')) CALL CRYPT_MENU()
	IF ((c_menu == 'Q') .OR. (c_menu == 'q')) STOP
	
END SUBROUTINE


!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! SUB GENKEY 						   !
! Key generation subroutine:                               !
!	generates a random key and prints it to the screen !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

SUBROUTINE GENKEY( )
	
	! variable definitions
	CHARACTER,DIMENSION(16)::key=" "
	REAL::rng_r
	INTEGER::i = 0, e_key = 0, rng_s = 128
	
	call RANDOM_SEED()
	! Randomize! 
	! 	In my brief research, I couldn't figure out what FORTRAN uses
	!	as its source of entropy. Therefore you should not use .this
	!	as a serious cryptographic system. Like most everything else
	!	at this school, this software merely serves as yet another 
	!	academic exercise.
	
	
	DO i = 1, 16
		! we need to generate a random character for each element of the
		! key array
		
		CALL RANDOM_NUMBER(rng_r)
	
		! this will provide an integer between 33 and 127, which is
		! conveniently is in the range of printable ASCII characters on
		! the keyboard
		e_key = INT(rng_r * 95) + 32
				
		!rng_r = 0
		
		! convert the integer to a character and store it in the key
		key(i)=ACHAR(e_key)
	END DO
	
	WRITE(*,*) 'New key: "', key, '"'
	WRITE(*,*) ""
	WRITE(*,*) "You are advised to write it down and keep it in a safe place."
END SUBROUTINE


!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! SUB CRYPT_MENU					   !
! Provides an interface to the encryption system	   !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

SUBROUTINE CRYPT_MENU( )

	CHARACTER::c_menu
	
	DO
		WRITE(*,*) "ENCRYPTION MENU"
		WRITE(*,*) "==============="
		WRITE(*,*) ""
		! jamais vu
		WRITE(*,*) "Operate on (K)eyboard input"
		WRITE(*,*) "(Q)uit to main menu"
		WRITE(*,*) ""
		WRITE(*,*) "Choice: "
		READ(*,*) c_menu
		
		IF ( (c_menu == 'K') .OR. (c_menu == 'k') ) CALL CRYPT_KB()
		IF ( (c_menu == 'Q') .OR. (c_menu == 'q') ) EXIT
	
	END DO


END SUBROUTINE


!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! SUB CRYPT_MENU					   !
! Provides an interface to the encryption system	   !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

SUBROUTINE CRYPT_KB( )
	CHARACTER(LEN=256)::input
	CHARACTER(LEN=16)::key
	CHARACTER::function
	INTEGER::i = 1, s_text = 0, s_rounds = 0
	LOGICAL::last_round = .FALSE.
	
	WRITE(*,*) "Enter the text (up to 256 characters): "
	READ(*,'(A256)') input
	
	WRITE(*,*) "Enter the key: "
	READ(*,'(A16)') key
	
	DO
		WRITE(*,*) "(E)ncrypt or (D)ecrypt? "
		READ(*,*) function
		
		IF ( (function == 'E') .OR. (function == 'D') ) EXIT
		IF ( (function == 'e') .OR. (function == 'd') ) EXIT
	
	END DO

	WRITE(*,*) "Text has been read as " 
	WRITE(*,*) "  ", TRIM(input)
	
	s_rounds = LEN_TRIM(input)
	!WRITE(*,*) s_rounds
	s_rounds = s_rounds / 16
	WRITE(*,*) "Actual length: ", LEN(input)
	WRITE(*,*) "  Trim length: ", LEN_TRIM(input)
	WRITE(*,*) " # rounds x16: ", s_rounds
	DO i = 0, s_rounds
	
		WRITE(*,*) "Round ", i
		IF ( i == s_rounds ) THEN 
			last_round = .TRUE.
			WRITE(*,*) "*** LAST ROUND"
		END IF
				
		IF ( (function == 'E') .OR. (function == 'e') ) CALL ENCRYPT(input(((i*16+1)):((i*16)+16)), key, last_round)
		IF ( (function == 'D') .OR. (function == 'd') ) CALL DECRYPT(input(((i*16+1)):((i*16)+16)), key, last_round)
	END DO
	
	WRITE(*,*) 'Output: "', TRIM(input), '"'
	
END SUBROUTINE


SUBROUTINE ENCRYPT(plaintext, key, lr)
	
	CHARACTER(LEN=16),INTENT(INOUT)::plaintext, key
	INTEGER::i = 1, i_tmp = 0, k_tmp = 0, tmp = 0
	LOGICAL,INTENT(IN)::lr
	
	WRITE(*,*) "plaintext length: ", LEN(plaintext)
	WRITE(*,*) "plaintext trim:   ", LEN_TRIM(plaintext)
	
	DO i = 1, 16
		i_tmp = IACHAR(plaintext(i:i))
		k_tmp = IACHAR(key(i:i))
		
		! preserve spaces
		IF ((lr .eqv. .FALSE.) .OR. (i <= LEN_TRIM(plaintext))) THEN
			tmp = i_tmp + k_tmp
			tmp = tmp - 95
		ELSE
			WRITE(*,*) 'Skipping.'
			WRITE(*,*) i_tmp
			tmp = i_tmp;
		END IF
		
		
		! need to make sure we're in the printable character range
		IF ( tmp > 126 ) THEN 
			tmp = tmp - 95
		END IF
		
		IF ( tmp < 32 ) THEN 
			tmp = tmp + 95
		END IF
		
		WRITE(*,*) i,') ',i_tmp,' (',ACHAR(i_tmp),') + ', k_tmp, ' (', ACHAR(k_tmp), ') = ', tmp, ' = ', ACHAR(tmp)
		plaintext(i:i) = ACHAR(tmp)
	END DO
		
END SUBROUTINE
	

SUBROUTINE DECRYPT(ciphertext, key, lr)

	CHARACTER(LEN=16),INTENT(INOUT)::ciphertext, key
	INTEGER::i = 1, i_tmp = 0, k_tmp = 0, tmp = 0
	LOGICAL,INTENT(IN)::lr
	
	DO i = 1, 16
		i_tmp = IACHAR(ciphertext(i:i))
		k_tmp = IACHAR(key(i:i))
		
		! preserve spaces
		IF ((lr .eqv. .FALSE.) .OR. (i <= LEN_TRIM(ciphertext))) THEN
			tmp = i_tmp - k_tmp
		ELSE 
			WRITE(*,*) "Skipping."
			tmp = 32;
		END IF
		
		
		! need to make sure we're in the printable character range
		IF ( tmp < 32 ) THEN
			WRITE(*,*) "Bump."
			tmp = tmp + 95
		END IF
		
		IF ( tmp < 32 ) THEN
			WRITE(*,*) "Bump."
			tmp = tmp + 95
		END IF
		
		WRITE(*,*) i,') ',i_tmp,' (',ACHAR(i_tmp),') - ', k_tmp, ' (', ACHAR(k_tmp), ') = ', tmp, ' = ', ACHAR(tmp)					
		ciphertext(i:i) = ACHAR(tmp)
	END DO
	
END SUBROUTINE
	
END PROGRAM