Calculating a CRC (Cyclic Redunancy Check)

DESCRIPTION

This is an example program that calculates a 32-bit version of the Cyclic Redundancy Check(CRC) for files listed on the command line.

This variant of CRC-32 uses LSB-first order, sets the initial CRC to FFFFFFFF_int32, and complements the final CRC.

The calculated CRC sum is calculated as a 32-bit value but returned as a 64-bit value, as Fortran does not currently support unsigned integers.

The input files are read as a stream of bytes in buffered blocks till the end for speed, especially on platforms that do not provide for read-ahead buffers.

The program was tested using GNU Fortran (GCC) 7.3.0.

EXAMPLE USAGE

 hasher *.f90
 1530940757            2011 dynamic_dummy_arrays.f90
 3570697645            5444 fspiro.f90
 3067489097           27108 pprint.f90
 0408522764            7273 hacker.f90

REFERENCES

• The CRC-32 algorithm was originally based on an unattributed example on http://rosettacode.org, but has been modified. The result should be in accordance with ISO 3309, ITU-T V.42, Gzip and PNG per this reference.

• Algorithms for many CRC algorithms can be found at “Computation of CRC” in Wikipedia.

• A description of a CRC is at https://en.wikipedia.org/wiki/Cyclic_redundancy_check

program hasher
!! calculate a CRC for files listed on the command line
use,intrinsic :: iso_fortran_env, only : ERROR_UNIT,iostat_end            ! access computing environment
use,intrinsic :: ISO_FORTRAN_ENV, only : int32,int64
implicit none
integer                         :: i
integer                         :: ios
integer                         :: icount
integer(kind=int64)             :: hash
integer,parameter               :: IUNIT=15       ! input file unit
character(len=4096)             :: msg
logical                         :: cont
integer,parameter               :: bufsize=1048576
character(len=1)                :: buff(bufsize)
integer                         :: sz
integer                         :: filepoint
integer                         :: count, longest, argument_length
character(len=:),allocatable    :: filenames(:)
   !! get command arguments
   count = command_argument_count() ! get number of filenames
   longest=0                        ! find longest argument
   do i=0,count
      call get_command_argument(number=i,length=argument_length)
      longest=max(longest,argument_length)
   enddo
   ! allocate string array big enough to hold command line
   allocate(character(len=longest) :: filenames(0:count))
   do i=0,count ! read the filenames into the array
      call get_command_argument(i, filenames(i))
   enddo
   !! step through files and calculate CRC
   do i=1,count
      !! open file assuming it is a regular file
      open(unit=IUNIT,file=filenames(i),status='old',access='stream',iostat=ios,iomsg=msg,action='read')
      if(ios.ne.0)then
         write(ERROR_UNIT,'(*(a))')'*hasher* error: file ',trim(filenames(i)),' message=',trim(msg)
         close(unit=IUNIT,iostat=ios)
         stop
      endif
      cont=.false.                                                 ! set flag this is initial call to calculate hash
      icount=0                                                     ! count number of characters processed
      sz=bufsize                                                   ! set read buffer size to initial size for new file
      filepoint=1                                                  ! position to start next read in file
      hash=0_int64                                                 ! initial hash value
      !! read blocks of the file, calculate continued CRC till end of file or error
      INFINITE: do                                                 ! read and sum file string by string
         read(iunit,iostat=ios,pos=filepoint,iomsg=msg) buff(1:sz) ! read data in large chunks till the last chunk
         if(is_iostat_end(ios))then                                ! this is the last buffer
            if(sz.ne.1)then                                        ! try again with a smaller buffer
               sz=max(1,sz/2)
               cycle INFINITE
            endif
         elseif(ios == 0)then                           ! no error occurred so successfully read a buffer
            filepoint=filepoint+sz
         endif
         if(ios /= 0)then                               ! quit reading on error
            exit INFINITE
         endif
         hash=crc32_hash(buff(:sz),continue=cont)       ! build up hash
         icount=icount+sz
         if(cont.eqv..false.)cont=.true.                ! change flag to continue hash build after first call to accumulate
      enddo INFINITE
      !! output values for current file
      if(icount.eq.0) then
         write(ERROR_UNIT,'(*(a))')'*hasher* error: file ',trim(filenames(i)),' is empty or not a readable regular file:',trim(msg)
      else
         write(*,'(i0.10,1x,i15,1x,a)')hash,icount,trim(filenames(i))
      endif
      close(unit=IUNIT,iostat=ios)
   enddo
contains
function crc32_hash(a,continue) result (crc_64)
use,intrinsic :: ISO_FORTRAN_ENV, only : int32,int64
implicit none
logical,intent(in),optional  :: continue
character(len=1),intent(in)  :: a(:)
integer(int64)               :: crc_64
integer(int32),save          :: crc
integer                      :: i
integer(int32),save          :: crc_table(0:255)
integer,save                 :: icalled=0
   if(present(continue))then
      if(continue .eqv. .false.)then
         crc=0_int32
      endif
   else
      crc=0_int32
   endif
   if(icalled.eq.0)then         ! on first call generate table and use table for speed
      INIT_TABLE: block
         integer :: i, j
         integer(int32) :: k
         do i = 0, 255
            k = i
            do j = 1, 8
               if (btest(k, 0)) then
                  k = ieor(shiftr(k, 1), -306674912_int32)
               else
                  k = shiftr(k, 1)
               endif
            enddo
            crc_table(i) = k
         enddo
      endblock INIT_TABLE
      icalled=1
   endif
   crc = not(crc)
   do i = 1, size(a)
      crc = ieor(shiftr(crc, 8), crc_table(iand(ieor(crc, iachar(a(i))), 255)))
   enddo
   crc = not(crc)
   crc_64=transfer([crc,0_int32],crc_64)
end function crc32_hash
end program hasher