'-------------------------------------------------------------------------------
'
'' Module: base64.bas
'
' Copyright 2005 Elba Corp.
' All rights reserved.
'
' Non-exclusive permission to use, copy, modify, and distribute this
' software for any purpose and without fee is hereby granted, provided:
'   1) that the above copyright notice is retained in the source code and,
'   2) that it is understood and agreed that no warranty of any kind,
'      express or implied is provided.
' Use of this code in any manner shall be prima facie evidence of
' acceptance of these terms.
'
' You may contact the author by email at dkinzer@zbasic.net.
'
'-------------------------------------------------------------------------------
'
' Overview:
'
' This module implements routines for handling base64 encoding/decoding.
' The encoding and decoding is compatible with that described in RFC 1421
' and RFC 1521 except that plaintext quoting and delimiting characters
' (other than whitespace) are not supported.  Also, the encoded string is
' not broken up into lines by generating end-of-line characters.
'
' The input and output buffers are passed to the encoding and decoding
' routines as memory addresses.  This allows these routines to be used
' with a variety of data sources and sinks.  Special care must be taken
' in order to use String data types as input and output buffers.  This is
' because the storage of the actual characters of a string is implementation
' dependent.  You'll have to read carefully the technical details for the
' type of string that you're using.
'
' Note: This module is written for ZBasic.  Because it uses some of the
' advanced features of ZBasic it will likely not compile without
' modifications for other Basic dialects.
'

'-------------------------------------------------------------------------------
'
'' Base64Len
'
' Given an input string length, determine the length that the string will be
' when encoded using the base64 alphabet.
'
Function Base64Len(ByVal strLen as Integer) As Integer
	If (strLen <= 0) Then
		Base64Len = 0
	Else
		' compute the expansion in size due to encoding
		Base64Len = ((strLen + 2) \ 3) * 4
	End If
End Function

'-------------------------------------------------------------------------------
'
'' Base64Encode
'
' Encode a string using the base64 alphabet, placing the encoded result in the
' given buffer.  The encoded string will be about 1/3 longer than the input string.
' Because of this, the output buffer must not be the same as the input buffer.
' The number of characters placed in the buffer will be returned.
'
' It is assumed that the given buffer length is sufficient to hold the encoded string.
' If not, the encoded string will be truncated after the last complete quad and a
' negative value will be returned.
'
Function Base64Encode(ByVal dataAddr as UnsignedInteger, ByVal dataLen as Integer, _
		ByVal bufAddr as UnsignedInteger, ByVal bufLen as Integer) as Integer

	' check input parameters
	If (dataLen <= 0) Then
		Base64Encode = 0
	ElseIf (bufLen < 4) Then
		Base64Encode = -1
	Else
		Dim byteCnt as Integer
		Dim c as Byte

		' convert 3 byte sequences into 4 byte sequences
		byteCnt = 0
		Do While (dataLen > 0)
			Dim cnt as Byte

			' make sure there's space left in the buffer for the next quad
			If (bufLen < 4) Then
				byteCnt = -byteCnt
				Exit Do
			End If

			' determine how many bytes to process on this pass
			If (dataLen >= 3) Then
				cnt = 3
			Else
				cnt = CByte(dataLen)
			End If

			' process the next three, two or one byte sequence
			Select Case cnt
			Case 3
				' generate the quad from the next three input bytes
				c = RamPeek(dataAddr + 0) \ 4
				Call RamPoke(base64Char(c), bufAddr + 0)
				c = ((RamPeek(dataAddr + 0) * 16) And &H30) + ((RamPeek(dataAddr + 1) \ 16) And &H0F)
				Call RamPoke(base64Char(c), bufAddr + 1)
				c = ((RamPeek(dataAddr + 1) * 4) And &H3C) + ((RamPeek(dataAddr + 2) \ 64) And &H03)
				Call RamPoke(base64Char(c), bufAddr + 2)
				c = RamPeek(dataAddr + 2)
				Call RamPoke(base64Char(c), bufAddr + 3)

			Case 2
				' encode the final two bytes
				c = RamPeek(dataAddr + 0) \ 4
				Call RamPoke(base64Char(c), bufAddr + 0)
				c = ((RamPeek(dataAddr + 0) * 16) And &H30) + ((RamPeek(dataAddr + 1) \ 16) And &H0F)
				Call RamPoke(base64Char(c), bufAddr + 1)
				c = (RamPeek(dataAddr + 1) * 4) And &H3C
				Call RamPoke(base64Char(c), bufAddr + 2)
				Call RamPoke(&H3D, bufAddr + 3)

			Case 1
				' encode the final byte
				c = RamPeek(dataAddr + 0) \ 4
				Call RamPoke(base64Char(c), bufAddr + 0)
				c = (RamPeek(dataAddr + 0) * 16) And &H30
				Call RamPoke(base64Char(c), bufAddr + 1)
				Call RamPoke(&H3D, bufAddr + 2)
				Call RamPoke(&H3D, bufAddr + 3)

			End Select

			' adjust indices and counts
			dataAddr = dataAddr + CUInt(cnt)
			dataLen = dataLen - CInt(cnt)
			bufAddr = bufAddr + 4
			bufLen = bufLen - 4
			byteCnt = byteCnt + 4
		Loop
		Base64Encode = byteCnt
	End If
End Function

'-------------------------------------------------------------------------------
'
'' Base64Decode
'
' Decode a base64-encoded string into plain text.
'
' The decoded string will always be shorter than the input string by
' approximately 25% (more if the input string contains whitespace).
' The output buffer may be the same as the input buffer.  The output
' buffer is assumed to be large enough to hold the decoded string.
'
' The number of characters placed in the output buffer is returned or a
' negative number in case of error (e.g. the input string contains an invalid
' character).
'
Function Base64Decode(ByVal dataAddr as UnsignedInteger, ByVal dataLen as Integer, _
		ByVal bufAddr as UnsignedInteger) as Integer
	Dim byteCnt as Integer
	Dim idx as Byte
	Dim list(0 to 2) as Byte

	byteCnt = 0
	idx = 0

	' check input parameters
	Do While (dataLen > 0)
		Dim val as Byte
		Dim vlen as Byte

		' retrieve the next byte to decode
		val = RamPeek(dataAddr)
		dataAddr = dataAddr + 1
		dataLen = dataLen - 1

		' convert base64 character to its ordinal value
		vlen = 1
		Select Case val
		Case &H41 to &H5A	' A-Z
			val = val - &H41 + 0

		Case &H61 to &H7A	' a-z
			val = val - &H61 + 26

		Case &H30 to &H39	' 0-9
			val = val - &H30 + 52

		Case &H2B			' +
			val = 62

		Case &H2F			' /
			val = 63

		Case &H3D			' =	(filler)
			vlen = 0

		Case &H20, &H09, &H0D, &H0A	' whitespace
			vlen = 0

		Case Else			' invalid character
			byteCnt = -1
			Exit Do

		End Select

		' process the value, if any
		If (vlen > 0) Then
			Select Case idx
			Case 0
				' put in MS 6 bits of first byte
				Call RamPoke((val * 4) And &HFC, bufAddr)

			Case 1
				' split between LS 2 bits of first byte (completing it) ...
				Call RamPoke(RamPeek(bufAddr) Or ((val \ 16) And &H03), bufAddr)
				byteCnt = byteCnt + 1
				bufAddr = bufAddr + 1

				' ... and the MS 4 bits of the second
				Call RamPoke((val * 16) And &HF0, bufAddr)

			Case 2
				' split between the LS 4 bits of the second byte (completing it) ...
				Call RamPoke(RamPeek(bufAddr) Or ((val \ 4) And &H0F), bufAddr)
				byteCnt = byteCnt + 1
				bufAddr = bufAddr + 1

				' ... and the MS 2 bits of the third
				Call RamPoke((val * 64) And &HC0, bufAddr)

			Case 3
				' occupies LS 6 bits of third byte, completing it
				Call RamPoke(RamPeek(bufAddr) Or (val And &H3F), bufAddr)
				byteCnt = byteCnt + 1
				bufAddr = bufAddr + 1

				' reset the byte counter to begin the cycle again
				idx = -1

			End Select
			idx = idx + 1
		End If
	Loop
	Base64Decode = byteCnt
End Function

'-------------------------------------------------------------------------------
'
' base64Char
'
' Given a value, return the corresponding base 64 character.  Only the least
' significant 6 bits of the value are considered.
'
' The base64 alphabet is:
'   ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/
'
Private Function base64Char(ByVal val as Byte) As Byte
	' limit the value to 6 bits
	val = val And &H3F

	If (val < 26) Then
		base64Char = val + &H41
	ElseIf (val < 52) Then
		base64Char = val - 26 + &H61
	ElseIf (val < 62) Then
		base64Char = val - 52 + &H30
	ElseIf (val = 62) Then
		base64Char = &H2B
	Else
		base64Char = &H2F
	End If
End Function

'-------------------------------------------------------------------------------
' Test code

' uncomment the following line to include a simple test routine
'#define TEST_DRIVER
#ifdef TEST_DRIVER

' define some test data to encode and decode
Dim testData as ByteVectorData({"The quick brown fox jumped over the lazy dog."})

Sub Main()
	Const origLen as Integer = SizeOf(testData)
	Dim origData(1 to origLen) as Byte
	Dim encData(1 to origLen * 4 \ 3) as Byte
	Dim encLen as Integer, outLen as Integer

	' load the test data into the buffer
	Call GetEEPROM(testData.DataAddress, origData, origLen)

	' display the original string
	Debug.Print "Original string:["; MakeString(origData.DataAddress, origLen); "]"
	
	' encode the data
	encLen = Base64Encode(origData.DataAddress, origLen, encData.DataAddress, SizeOf(encData))
	If (encLen < 0) Then
		Debug.Print "encoding buffer is too small"
	Else
		' display the encoded string
		Debug.Print "Encoded string: ["; MakeString(encData.DataAddress, encLen); "]"

		' decode the data back to the original buffer
		outLen = Base64Decode(encData.DataAddress, encLen, origData.DataAddress)
		If (outLen < 0) Then
			Debug.Print "encoded string contains an invalid character"
		Else
			' display the decoded string (s/b same as original)
			Debug.Print "Decoded string: ["; MakeString(origData.DataAddress, outLen); "]"
			Debug.Print
		End If
	End If
End Sub
#endif