hvs_base64_module.f90 Source File

! Copyright (c) 2015 Kannan Masilamani <kannan.masilamani@uni-siegen.de>
! Copyright (c) 2016 Tobias Schneider <tobias1.schneider@student.uni-siegen.de>
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
!
! 1. Redistributions of source code must retain the above copyright notice, this
! list of conditions and the following disclaimer.
!
! 2. Redistributions in binary form must reproduce the above copyright notice,
! this list of conditions and the following disclaimer in the documentation
! and/or other materials provided with the distribution.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
! AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
! IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
! DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
! FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
! SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
! OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
! ****************************************************************************** !
!> This module provides the methods for base64Encoding.
!!
module hvs_base64_module

  ! include treelm modules
  use env_module, only: rk

  ! include harvester modules
  use hvs_sizeof_module, only: c_sizeof

  use, intrinsic :: iso_c_binding, only: c_ptr, c_int, c_double, c_float,      &
    &                                    c_int_least8_t, c_int_least64_t,      &
    &                                    c_char, c_loc

  implicit none

  integer, parameter :: EncoderLen = 4
  integer, parameter :: EncoderBlockLen = 3

  !> Convert one block of input (3 Bytes) into its base64
  !! representation (4 Bytes).
  interface
    function EncodeBlock( input, output, iplen, oplen )                        &
      & bind(c, name='encodeblock')
      use, intrinsic :: iso_c_binding
      !> input character stream in ascii
      type(c_ptr), value :: input

      !> output character stream in base64
      type(c_ptr), value :: output

      !> length of the input stream
      integer(kind=c_int), value, intent(in) :: iplen

      !> length of the output stream
      integer(kind=c_int), value :: oplen

      !> Result, indicating the status of encode
      integer(kind=c_int) :: EncodeBlock
    end function EncodeBlock
  end interface

  !> Interface to convert ascii to binary base64 encoder
  interface
    function EncodeIndex( input, output, iplen, ind, ipindex )                 &
      & bind(c, name='EncodeIndex')
      use, intrinsic :: iso_c_binding
      !> input character stream in ascii
      type(c_ptr), value :: input

      !> output character stream in base64
      type(c_ptr), value :: output

      !> length of the input stream
      integer(kind=c_int), value, intent(in) :: iplen

      !> current length
      integer(kind=c_int), value :: ind

      !> current length
      integer(kind=c_int), value :: ipindex

      !> Result, indicating the status of encode
      integer(kind=c_int) :: EncodeIndex
    end function EncodeIndex
  end interface

  !> Interface to convert ascii to binary base64 encoder
  interface
    function Base64Encode( input, output, iplen, oplen, ipindex )              &
      & bind(c, name='Base64Encode')
      use, intrinsic :: iso_c_binding
      !> input character stream in ascii
      type(c_ptr), value :: input

      !> output character stream in base64
      type(c_ptr), value :: output

      !> length of the input stream
      integer(kind=c_int), value, intent(in) :: iplen

      !> length of the output stream
      integer(kind=c_int), value :: oplen

      !> current length
      integer(kind=c_int), value :: ipindex

      !> Result, indicating the status of encode
      integer(kind=c_int) :: Base64Encode
    end function Base64Encode
  end interface

  interface convert_to_Base64
    module procedure real32_to_base64
    module procedure real64_to_base64
    module procedure char_to_base64
    module procedure int8_to_base64
    module procedure int32_to_base64
    module procedure int64_to_base64
  end interface convert_to_Base64

  interface convert_to_Base64_single
    module procedure real32_to_base64_single
    module procedure real64_to_base64_single
    module procedure char_to_base64_single
    module procedure int8_to_base64_single
    module procedure int32_to_base64_single
    module procedure int64_to_base64_single
  end interface convert_to_Base64_single


contains



! ****************************************************************************** !
  !> this routine encodes data of type real64 to base64 format
  !!
  subroutine real64_to_base64( indata, iplen, outfile )
    ! ---------------------------------------------------------------------------
    !> size of data to be encoded
    integer, intent(in) :: iplen
    !> data to be encoded
    real(kind=c_double), target, intent(in) :: indata(iplen)
    !> output file unit
    integer, intent(in) :: outfile
    ! ---------------------------------------------------------------------------
    integer(kind=c_int) :: baserc
    integer(kind=c_int) :: insize, outsize, ipindex, min_iplen
    integer :: ind
    type(c_ptr) :: base64_out
    type(c_ptr) :: base64_in
    type(c_ptr) :: encoder_in
    character, target :: base64_string(encoderlen), encoder_str(encoderblocklen)
    ! ---------------------------------------------------------------------------

    base64_in = c_loc(indata)

    insize = int(c_sizeof(indata(1))*iplen, kind=4)

    ! write insize i.e bit size in the beginning of the string
    call convert_to_base64_single( insize, outfile )

    outsize = ceiling(insize/3._rk)*4

    base64_out = c_loc(base64_string)

    encoder_in = c_loc(encoder_str)

    ipindex = 0
    do
      do ind = 0, 2
        baserc = encodeindex( base64_in, encoder_in, insize, ind, ipindex )
        ipindex = ipindex + 1
      end do
      min_iplen = min(insize - ipindex + 3, 3)
      baserc = encodeblock( encoder_in, base64_out, min_iplen, outsize )
      write(outfile) base64_string
      if (ipindex >= insize) exit
    end do

  end subroutine real64_to_base64
! ****************************************************************************** !


! ****************************************************************************** !
  !> this routine encodes a single variable of type real64 into base64 format
  !!
  subroutine real64_to_base64_single( indata, outfile )
    ! ---------------------------------------------------------------------------
    !> data to be encoded
    real(kind=c_double), target, intent(in) :: indata
    !> output file unit
    integer, intent(in) :: outfile
    ! ---------------------------------------------------------------------------
    integer(kind=c_int) :: baserc
    integer(kind=c_int) :: insize, outsize, ipindex, min_iplen
    integer :: ind
    type(c_ptr) :: base64_out
    type(c_ptr) :: base64_in
    type(c_ptr) :: encoder_in
    character, target :: base64_string(encoderlen), encoder_str(encoderblocklen)
    ! ---------------------------------------------------------------------------

    base64_in = c_loc(indata)

    insize = int(c_sizeof(indata), kind=4)

    outsize = ceiling(insize/3._rk)*4

    base64_out = c_loc(base64_string)

    encoder_in = c_loc(encoder_str)

    ipindex = 0
    do
      do ind = 0, 2
        baserc = encodeindex( base64_in, encoder_in, insize, ind, ipindex )
        ipindex = ipindex + 1
      end do
      min_iplen = min(insize - ipindex + 3, 3)
      baserc = encodeblock( encoder_in, base64_out, min_iplen, outsize )
      write(outfile) base64_string
      if (ipindex >= insize) exit
    end do

  end subroutine real64_to_base64_single
! ****************************************************************************** !

! ****************************************************************************** !
  !> this routine encodes data of type real32 to base64 format
  !!
  subroutine real32_to_base64( indata, iplen, outfile )
    ! ---------------------------------------------------------------------------
    !> size of data to be encoded
    integer, intent(in) :: iplen
    !> data to be encoded
    real(kind=c_float), target, intent(in) :: indata(iplen)
    !> output file unit
    integer, intent(in) :: outfile
    ! ---------------------------------------------------------------------------
    integer(kind=c_int) :: baserc
    integer(kind=c_int) :: insize, outsize, ipindex, min_iplen
    integer :: ind
    type(c_ptr) :: base64_out
    type(c_ptr) :: base64_in
    type(c_ptr) :: encoder_in
    character, target :: base64_string(encoderlen), encoder_str(encoderblocklen)
    ! ---------------------------------------------------------------------------

    base64_in = c_loc(indata)

    insize = int(c_sizeof(indata(1))*iplen, kind=4)

    ! write insize i.e bit size in the beginning of the string
    call convert_to_base64_single( insize, outfile )

    outsize = ceiling(insize/3._rk)*4

    base64_out = c_loc(base64_string)

    encoder_in = c_loc(encoder_str)

    ipindex = 0
    do
      do ind = 0, 2
        baserc = encodeindex( base64_in, encoder_in, insize, ind, ipindex )
        ipindex = ipindex + 1
      end do
      min_iplen = min(insize - ipindex + 3, 3)
      baserc = encodeblock( encoder_in, base64_out, min_iplen, outsize )
      write(outfile) base64_string
      if (ipindex >= insize) exit
    end do

  end subroutine real32_to_base64
! ****************************************************************************** !


! ****************************************************************************** !
  !> this routine encodes a single variable of type real32 into base64 format
  !!
  subroutine real32_to_base64_single( indata, outfile )
    ! ---------------------------------------------------------------------------
    !> data to be encoded
    real(kind=c_float), target, intent(in) :: indata
    !> output file unit
    integer, intent(in) :: outfile
    ! ---------------------------------------------------------------------------
    integer(kind=c_int) :: baserc
    integer(kind=c_int) :: insize, outsize, ipindex, min_iplen
    integer :: ind
    type(c_ptr) :: base64_out
    type(c_ptr) :: base64_in
    type(c_ptr) :: encoder_in
    character, target :: base64_string(encoderlen), encoder_str(encoderblocklen)
    ! ---------------------------------------------------------------------------

    base64_in = c_loc(indata)

    insize = int(c_sizeof(indata), kind=4)

    outsize = ceiling(insize/3._rk)*4

    base64_out = c_loc(base64_string)

    encoder_in = c_loc(encoder_str)

    ipindex = 0
    do
      do ind = 0, 2
        baserc = encodeindex( base64_in, encoder_in, insize, ind, ipindex )
        ipindex = ipindex + 1
      end do
      min_iplen = min(insize - ipindex + 3, 3)
      baserc = encodeblock( encoder_in, base64_out, min_iplen, outsize )
      write(outfile) base64_string
      if (ipindex >= insize) exit
    end do

  end subroutine real32_to_base64_single
! ****************************************************************************** !

! ****************************************************************************** !
  !> this routine encodes data of type int8 to base64 format
  !!
  subroutine int8_to_base64( indata, iplen, outfile )
    ! ---------------------------------------------------------------------------
    !> size of data to be encoded
    integer, intent(in) :: iplen
    !> data to be encoded
    integer(kind=c_int_least8_t), target, intent(in) :: indata(iplen)
    !> output file unit
    integer, intent(in) :: outfile
    ! ---------------------------------------------------------------------------
    integer(kind=c_int) :: baserc
    integer(kind=c_int) :: insize, outsize, ipindex, min_iplen
    integer :: ind
    type(c_ptr) :: base64_out
    type(c_ptr) :: base64_in
    type(c_ptr) :: encoder_in
    character, target :: base64_string(encoderlen), encoder_str(encoderblocklen)
    ! ---------------------------------------------------------------------------

    base64_in = c_loc(indata)

    insize = int(c_sizeof(indata(1))*iplen, kind=4)

    ! write insize i.e bit size in the beginning of the string
    call convert_to_base64_single( insize, outfile )

    outsize = ceiling(insize/3._rk)*4

    base64_out = c_loc(base64_string)

    encoder_in = c_loc(encoder_str)

    ipindex = 0
    do
      do ind = 0, 2
        baserc = encodeindex( base64_in, encoder_in, insize, ind, ipindex )
        ipindex = ipindex + 1
      end do
      min_iplen = min(insize - ipindex + 3, 3)
      baserc = encodeblock( encoder_in, base64_out, min_iplen, outsize )
      write(outfile) base64_string
      if (ipindex >= insize) exit
    end do

  end subroutine int8_to_base64
! ****************************************************************************** !


! ****************************************************************************** !
  !> this routine encodes a single variable of type int8 into base64 format
  !!
  subroutine int8_to_base64_single( indata, outfile )
    ! ---------------------------------------------------------------------------
    !> data to be encoded
    integer(kind=c_int_least8_t), target, intent(in) :: indata
    !> output file unit
    integer, intent(in) :: outfile
    ! ---------------------------------------------------------------------------
    integer(kind=c_int) :: baserc
    integer(kind=c_int) :: insize, outsize, ipindex, min_iplen
    integer :: ind
    type(c_ptr) :: base64_out
    type(c_ptr) :: base64_in
    type(c_ptr) :: encoder_in
    character, target :: base64_string(encoderlen), encoder_str(encoderblocklen)
    ! ---------------------------------------------------------------------------

    base64_in = c_loc(indata)

    insize = int(c_sizeof(indata), kind=4)

    outsize = ceiling(insize/3._rk)*4

    base64_out = c_loc(base64_string)

    encoder_in = c_loc(encoder_str)

    ipindex = 0
    do
      do ind = 0, 2
        baserc = encodeindex( base64_in, encoder_in, insize, ind, ipindex )
        ipindex = ipindex + 1
      end do
      min_iplen = min(insize - ipindex + 3, 3)
      baserc = encodeblock( encoder_in, base64_out, min_iplen, outsize )
      write(outfile) base64_string
      if (ipindex >= insize) exit
    end do

  end subroutine int8_to_base64_single
! ****************************************************************************** !

! ****************************************************************************** !
  !> this routine encodes data of type int32 to base64 format
  !!
  subroutine int32_to_base64( indata, iplen, outfile )
    ! ---------------------------------------------------------------------------
    !> size of data to be encoded
    integer, intent(in) :: iplen
    !> data to be encoded
    integer(kind=c_int), target, intent(in) :: indata(iplen)
    !> output file unit
    integer, intent(in) :: outfile
    ! ---------------------------------------------------------------------------
    integer(kind=c_int) :: baserc
    integer(kind=c_int) :: insize, outsize, ipindex, min_iplen
    integer :: ind
    type(c_ptr) :: base64_out
    type(c_ptr) :: base64_in
    type(c_ptr) :: encoder_in
    character, target :: base64_string(encoderlen), encoder_str(encoderblocklen)
    ! ---------------------------------------------------------------------------

    base64_in = c_loc(indata)

    insize = int(c_sizeof(indata(1))*iplen, kind=4)

    ! write insize i.e bit size in the beginning of the string
    call convert_to_base64_single( insize, outfile )

    outsize = ceiling(insize/3._rk)*4

    base64_out = c_loc(base64_string)

    encoder_in = c_loc(encoder_str)

    ipindex = 0
    do
      do ind = 0, 2
        baserc = encodeindex( base64_in, encoder_in, insize, ind, ipindex )
        ipindex = ipindex + 1
      end do
      min_iplen = min(insize - ipindex + 3, 3)
      baserc = encodeblock( encoder_in, base64_out, min_iplen, outsize )
      write(outfile) base64_string
      if (ipindex >= insize) exit
    end do

  end subroutine int32_to_base64
! ****************************************************************************** !


! ****************************************************************************** !
  !> this routine encodes a single variable of type int32 into base64 format
  !!
  subroutine int32_to_base64_single( indata, outfile )
    ! ---------------------------------------------------------------------------
    !> data to be encoded
    integer(kind=c_int), target, intent(in) :: indata
    !> output file unit
    integer, intent(in) :: outfile
    ! ---------------------------------------------------------------------------
    integer(kind=c_int) :: baserc
    integer(kind=c_int) :: insize, outsize, ipindex, min_iplen
    integer :: ind
    type(c_ptr) :: base64_out
    type(c_ptr) :: base64_in
    type(c_ptr) :: encoder_in
    character, target :: base64_string(encoderlen), encoder_str(encoderblocklen)
    ! ---------------------------------------------------------------------------

    base64_in = c_loc(indata)

    insize = int(c_sizeof(indata), kind=4)

    outsize = ceiling(insize/3._rk)*4

    base64_out = c_loc(base64_string)

    encoder_in = c_loc(encoder_str)

    ipindex = 0
    do
      do ind = 0, 2
        baserc = encodeindex( base64_in, encoder_in, insize, ind, ipindex )
        ipindex = ipindex + 1
      end do
      min_iplen = min(insize - ipindex + 3, 3)
      baserc = encodeblock( encoder_in, base64_out, min_iplen, outsize )
      write(outfile) base64_string
      if (ipindex >= insize) exit
    end do

  end subroutine int32_to_base64_single
! ****************************************************************************** !

! ****************************************************************************** !
  !> this routine encodes data of type int64 to base64 format
  !!
  subroutine int64_to_base64( indata, iplen, outfile )
    ! ---------------------------------------------------------------------------
    !> size of data to be encoded
    integer, intent(in) :: iplen
    !> data to be encoded
    integer(kind=c_int_least64_t), target, intent(in) :: indata(iplen)
    !> output file unit
    integer, intent(in) :: outfile
    ! ---------------------------------------------------------------------------
    integer(kind=c_int) :: baserc
    integer(kind=c_int) :: insize, outsize, ipindex, min_iplen
    integer :: ind
    type(c_ptr) :: base64_out
    type(c_ptr) :: base64_in
    type(c_ptr) :: encoder_in
    character, target :: base64_string(encoderlen), encoder_str(encoderblocklen)
    ! ---------------------------------------------------------------------------

    base64_in = c_loc(indata)

    insize = int(c_sizeof(indata(1))*iplen, kind=4)

    ! write insize i.e bit size in the beginning of the string
    call convert_to_base64_single( insize, outfile )

    outsize = ceiling(insize/3._rk)*4

    base64_out = c_loc(base64_string)

    encoder_in = c_loc(encoder_str)

    ipindex = 0
    do
      do ind = 0, 2
        baserc = encodeindex( base64_in, encoder_in, insize, ind, ipindex )
        ipindex = ipindex + 1
      end do
      min_iplen = min(insize - ipindex + 3, 3)
      baserc = encodeblock( encoder_in, base64_out, min_iplen, outsize )
      write(outfile) base64_string
      if (ipindex >= insize) exit
    end do

  end subroutine int64_to_base64
! ****************************************************************************** !


! ****************************************************************************** !
  !> this routine encodes a single variable of type int64 into base64 format
  !!
  subroutine int64_to_base64_single( indata, outfile )
    ! ---------------------------------------------------------------------------
    !> data to be encoded
    integer(kind=c_int_least64_t), target, intent(in) :: indata
    !> output file unit
    integer, intent(in) :: outfile
    ! ---------------------------------------------------------------------------
    integer(kind=c_int) :: baserc
    integer(kind=c_int) :: insize, outsize, ipindex, min_iplen
    integer :: ind
    type(c_ptr) :: base64_out
    type(c_ptr) :: base64_in
    type(c_ptr) :: encoder_in
    character, target :: base64_string(encoderlen), encoder_str(encoderblocklen)
    ! ---------------------------------------------------------------------------

    base64_in = c_loc(indata)

    insize = int(c_sizeof(indata), kind=4)

    outsize = ceiling(insize/3._rk)*4

    base64_out = c_loc(base64_string)

    encoder_in = c_loc(encoder_str)

    ipindex = 0
    do
      do ind = 0, 2
        baserc = encodeindex( base64_in, encoder_in, insize, ind, ipindex )
        ipindex = ipindex + 1
      end do
      min_iplen = min(insize - ipindex + 3, 3)
      baserc = encodeblock( encoder_in, base64_out, min_iplen, outsize )
      write(outfile) base64_string
      if (ipindex >= insize) exit
    end do

  end subroutine int64_to_base64_single
! ****************************************************************************** !

! ****************************************************************************** !
  !> this routine encodes data of type char to base64 format
  !!
  subroutine char_to_base64( indata, iplen, outfile )
    ! ---------------------------------------------------------------------------
    !> size of data to be encoded
    integer, intent(in) :: iplen
    !> data to be encoded
    character(kind=c_char), target, intent(in) :: indata(iplen)
    !> output file unit
    integer, intent(in) :: outfile
    ! ---------------------------------------------------------------------------
    integer(kind=c_int) :: baserc
    integer(kind=c_int) :: insize, outsize, ipindex, min_iplen
    integer :: ind
    type(c_ptr) :: base64_out
    type(c_ptr) :: base64_in
    type(c_ptr) :: encoder_in
    character, target :: base64_string(encoderlen), encoder_str(encoderblocklen)
    ! ---------------------------------------------------------------------------

    base64_in = c_loc(indata)

    insize = int(c_sizeof(indata(1))*iplen, kind=4)

    ! write insize i.e bit size in the beginning of the string
    call convert_to_base64_single( insize, outfile )

    outsize = ceiling(insize/3._rk)*4

    base64_out = c_loc(base64_string)

    encoder_in = c_loc(encoder_str)

    ipindex = 0
    do
      do ind = 0, 2
        baserc = encodeindex( base64_in, encoder_in, insize, ind, ipindex )
        ipindex = ipindex + 1
      end do
      min_iplen = min(insize - ipindex + 3, 3)
      baserc = encodeblock( encoder_in, base64_out, min_iplen, outsize )
      write(outfile) base64_string
      if (ipindex >= insize) exit
    end do

  end subroutine char_to_base64
! ****************************************************************************** !


! ****************************************************************************** !
  !> this routine encodes a single variable of type char into base64 format
  !!
  subroutine char_to_base64_single( indata, outfile )
    ! ---------------------------------------------------------------------------
    !> data to be encoded
    character(kind=c_char), target, intent(in) :: indata
    !> output file unit
    integer, intent(in) :: outfile
    ! ---------------------------------------------------------------------------
    integer(kind=c_int) :: baserc
    integer(kind=c_int) :: insize, outsize, ipindex, min_iplen
    integer :: ind
    type(c_ptr) :: base64_out
    type(c_ptr) :: base64_in
    type(c_ptr) :: encoder_in
    character, target :: base64_string(encoderlen), encoder_str(encoderblocklen)
    ! ---------------------------------------------------------------------------

    base64_in = c_loc(indata)

    insize = int(c_sizeof(indata), kind=4)

    outsize = ceiling(insize/3._rk)*4

    base64_out = c_loc(base64_string)

    encoder_in = c_loc(encoder_str)

    ipindex = 0
    do
      do ind = 0, 2
        baserc = encodeindex( base64_in, encoder_in, insize, ind, ipindex )
        ipindex = ipindex + 1
      end do
      min_iplen = min(insize - ipindex + 3, 3)
      baserc = encodeblock( encoder_in, base64_out, min_iplen, outsize )
      write(outfile) base64_string
      if (ipindex >= insize) exit
    end do

  end subroutine char_to_base64_single
! ****************************************************************************** !


end module hvs_base64_module
! ****************************************************************************** !