[m-rev.] diff: add base64 encoding lib to extras

[Peter Ross]

Hi,

I've started to move the libraries developed at MC into extras.
The plan is to just check them in, and if you guys want to change
the coding standards, etc., etc., feel free.

===================================================================


Estimated hours taken: 1
Branches: main

extras/README:
extras/base64/base64.m:
	Add routines for encoding and decoding base64 strings.

Index: extras/README
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/README,v
retrieving revision 1.18
diff -U5 -r1.18 README
--- extras/README	7 Sep 2006 08:32:19 -0000	1.18
+++ extras/README	10 Nov 2006 01:45:29 -0000
@@ -3,10 +3,12 @@
 
 Most of these can be built by running the commands `mmake depend' and
 then `mmake' in the relevant subdirectory, and many can be installed by
 running `mmake install'.
 
+base64          A library for base64 encoding and decoding.
+
 cgi		A couple of Mercury library modules for doing HTML forms
 		programming using CGI (Common Gateway Interface).
 
 complex_numbers
 		A Mercury library package containing support for

New File: extras/base64/base64.m
===================================================================
%------------------------------------------------------------------------------%
% base64.m
% Michel Dehennin <mdh at missioncriticalit.com>
%
% Original C code is public domain code provided by TeX User Group
% http://www.tug.org/ftp/vm/base64-decode.c
% http://www.tug.org/ftp/vm/base64-encode.c
%
% This code is in the public domain.
%
%------------------------------------------------------------------------------%

:- module base64.

:- interface.

:- import_module list.

    %
    % Encode a string in base64.
    %
:- pred encode64(string::in, string::out) is det.

    %
    % Encodes a list of bytes as a base 64 string.
    % Note this means that the integers must be in the range 0-255.
    % This constrain is not checked.
    %
:- pred encode64_byte_list(list(int)::in, string::out) is det.

    %
    % Decodes a base64 string to clear text.
    % WARNING: If the resulting string contains non-terminating null characters,
    % as in a PDF file for instance, the string is likely to be truncated
    %
:- pred decode64(string::in, string::out) is det.

%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%

:- implementation.

:- import_module bool, char, int, float, string.
:- import_module list, map, set.
:- import_module exception, require, std_util.


encode64(Data, Base64) :-
    encode64(Data, string.length(Data), Base64).

:- pred encode64(string::in, int::in, string::out) is det.

:- pragma foreign_decl(c, local, "
#include <string.h>

unsigned char alphabet[64] = \"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/\";

").

:- pragma foreign_proc(c,
		encode64(Data::in, Len::in, Base64::out),
        [will_not_call_mercury, thread_safe, promise_pure], "
{
    MR_Word	base64_buff;
    char *base64_ptr;

    int cols, bits, c, char_count;
    int i;

    /*
     * Base64 encoded data uses 4:3 times more space than the original string
     * We need to foresee an extra MR_Word for the string terminator character 
     */
    MR_offset_incr_hp_atomic(base64_buff, 0, ((((Len + 2) / 3) * 4) + sizeof(MR_Word)) / sizeof(MR_Word));
    base64_ptr = (char *) base64_buff;	

    char_count = 0;
    bits = 0;
    cols = 0;

    for(i = 0; i < Len; i++) {
    	/* need to cast to an unsigned char otherwise we might get negative values */
    	c = (unsigned char) Data[i];
    	bits += c;

    	char_count++;
    	if (char_count == 3) {
    		*base64_ptr++ = alphabet[bits >> 18];
    		*base64_ptr++ = alphabet[(bits >> 12) & 0x3f];
    		*base64_ptr++ = alphabet[(bits >> 6) & 0x3f];
    		*base64_ptr++ = alphabet[bits & 0x3f];
    		
    		/* Invalidates the size of allocated memory */
    		/*
    		cols += 4;
    		if (cols == 72) {
    			putchar('\n');
    			cols = 0;
    		}
    		*/
    		bits = 0;
    		char_count = 0;
    	} else {
    		bits <<= 8;
    	}
    }
    
    if (char_count != 0) {
    	bits <<= 16 - (8 * char_count);
    	*base64_ptr++ = alphabet[bits >> 18];
		*base64_ptr++ = alphabet[(bits >> 12) & 0x3f];
    	if (char_count == 1) {
    		*base64_ptr++ = '=';
    		*base64_ptr++ = '=';
    	} else {
    		*base64_ptr++ = alphabet[(bits >> 6) & 0x3f];
    		*base64_ptr++ = '=';
    	}
    	/*
    	if (cols > 0)
    		putchar('\n');
    	*/
    }

	*base64_ptr = '\\0';

    Base64 = (char *) base64_buff;
}
").

:- pragma foreign_proc(c,
		decode64(Base64::in, Data::out),
        [will_not_call_mercury, thread_safe, promise_pure], "
{
    MR_Word	data_buff;
    char *data_ptr;

    static char inalphabet[256], decoder[256];
    int i, bits, c, char_count, errors = 0;

    /* 
     * Decoded data uses 3:4 of the space of the Base64 string
     */
    MR_offset_incr_hp_atomic(data_buff, 0, (((strlen(Base64) * 3) / 4) + sizeof(MR_Word)) / sizeof(MR_Word));
    data_ptr = (char *) data_buff;	

    for (i = (sizeof alphabet) - 1; i >= 0 ; i--) {
    	inalphabet[alphabet[i]] = 1;
    	decoder[alphabet[i]] = i;
    }

    char_count = 0;
    bits = 0;
    for(i = 0; i < strlen(Base64); i++) {
    	/* need to cast to an unsigned char otherwise we might get negative values */
    	c = (unsigned char) Base64[i];
    	if (c == '=')
    	  break;

    	/* Skip invalid characters */
    	if (c > 255 || ! inalphabet[c])
    	  continue;
    	
    	bits += decoder[c];
    	char_count++;
    	if (char_count == 4) {
    		*data_ptr++ = (bits >> 16);
    		*data_ptr++ = ((bits >> 8) & 0xff);
    		*data_ptr++ = (bits & 0xff);
    	    bits = 0;
    	    char_count = 0;
    	} else {
    	    bits <<= 6;
    	}
    }

    if (i == strlen(Base64)) {
    	if (char_count) {
    	    fprintf(stderr, \"base64 encoding incomplete: at least %d bits truncated\",
    		    ((4 - char_count) * 6));
    	    errors++;
    	}
    } else { /* c == '=' */
    	switch (char_count) {
    	  case 1:
    	    fprintf(stderr, \"base64 encoding incomplete: at least 2 bits missing\");
    	    errors++;
    	    break;
    	  case 2:
    	  	*data_ptr++ = (bits >> 10);
    	    break;
    	  case 3:
    	  	*data_ptr++ = (bits >> 16);
    	  	*data_ptr++ = ((bits >> 8) & 0xff);
    	    break;
    	}
    }

    *data_ptr = '\\0';

	Data = (char *) data_buff;
}
").

    %
    % We define our own version of map/2 so that we can
    % apply the --optimize-constructor-last-call optimization
    % (this optimization is turned off for the standard
    % library by default).
    %
:- func base64.map(func(X) = Y, list(X)) = list(Y).

base64.map(_, []) =  [].
base64.map(F, [H0 | T0]) = [H | T] :-
    H = F(H0),
    T = base64.map(F, T0).
        
encode64_byte_list(Bytes, Base64) :-
    Chars = base64.map(char.det_from_int, Bytes),
    Length = list.length(Chars),
    String = string.from_char_list(Chars),
    encode64(String, Length, Base64).

:- end_module base64.
%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et tw=0 wm=0

--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------