This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
9cbf2b548e98a15620e1fc40e641da0d97ecef4d
[perl5.git] / ext / MIME / Base64 / Base64.xs
1 /* $Id: Base64.xs,v 1.37 2003/05/13 18:20:18 gisle Exp $
2
3 Copyright 1997-2003 Gisle Aas
4
5 This library is free software; you can redistribute it and/or
6 modify it under the same terms as Perl itself.
7
8
9 The tables and some of the code that used to be here was borrowed from
10 metamail, which comes with this message:
11
12   Copyright (c) 1991 Bell Communications Research, Inc. (Bellcore)
13
14   Permission to use, copy, modify, and distribute this material
15   for any purpose and without fee is hereby granted, provided
16   that the above copyright notice and this permission notice
17   appear in all copies, and that the name of Bellcore not be
18   used in advertising or publicity pertaining to this
19   material without the specific, prior written permission
20   of an authorized representative of Bellcore.  BELLCORE
21   MAKES NO REPRESENTATIONS ABOUT THE ACCURACY OR SUITABILITY
22   OF THIS MATERIAL FOR ANY PURPOSE.  IT IS PROVIDED "AS IS",
23   WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
24
25 */
26
27
28 #ifdef __cplusplus
29 extern "C" {
30 #endif
31 #include "EXTERN.h"
32 #include "perl.h"
33 #include "XSUB.h"
34 #ifdef __cplusplus
35 }
36 #endif
37
38 #ifndef PATCHLEVEL
39 #    include <patchlevel.h>
40 #    if !(defined(PERL_VERSION) || (SUBVERSION > 0 && defined(PATCHLEVEL)))
41 #        include <could_not_find_Perl_patchlevel.h>
42 #    endif
43 #endif
44
45 #if PATCHLEVEL <= 4 && !defined(PL_dowarn)
46    #define PL_dowarn dowarn
47 #endif
48
49 #ifdef G_WARN_ON
50    #define DOWARN (PL_dowarn & G_WARN_ON)
51 #else
52    #define DOWARN PL_dowarn
53 #endif
54
55
56 #define MAX_LINE  76 /* size of encoded lines */
57
58 static char basis_64[] =
59    "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
60
61 #define XX      255     /* illegal base64 char */
62 #define EQ      254     /* padding */
63 #define INVALID XX
64
65 static unsigned char index_64[256] = {
66     XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
67     XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
68     XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,62, XX,XX,XX,63,
69     52,53,54,55, 56,57,58,59, 60,61,XX,XX, XX,EQ,XX,XX,
70     XX, 0, 1, 2,  3, 4, 5, 6,  7, 8, 9,10, 11,12,13,14,
71     15,16,17,18, 19,20,21,22, 23,24,25,XX, XX,XX,XX,XX,
72     XX,26,27,28, 29,30,31,32, 33,34,35,36, 37,38,39,40,
73     41,42,43,44, 45,46,47,48, 49,50,51,XX, XX,XX,XX,XX,
74
75     XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
76     XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
77     XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
78     XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
79     XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
80     XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
81     XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
82     XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX, XX,XX,XX,XX,
83 };
84
85 #ifdef SvPVbyte
86 #   if PERL_REVISION == 5 && PERL_VERSION < 7
87        /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */
88 #       undef SvPVbyte
89 #       define SvPVbyte(sv, lp) \
90           ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
91            ? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp))
92        static char *
93        my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp)
94        {   
95            sv_utf8_downgrade(sv,0);
96            return SvPV(sv,*lp);
97        }
98 #   endif
99 #else
100 #   define SvPVbyte SvPV
101 #endif
102
103 #ifndef NATIVE_TO_ASCII
104 #   define NATIVE_TO_ASCII(ch) (ch)
105 #endif
106
107 MODULE = MIME::Base64           PACKAGE = MIME::Base64
108
109 SV*
110 encode_base64(sv,...)
111         SV* sv
112         PROTOTYPE: $;$
113
114         PREINIT:
115         char *str;     /* string to encode */
116         SSize_t len;   /* length of the string */
117         char *eol;     /* the end-of-line sequence to use */
118         STRLEN eollen; /* length of the EOL sequence */
119         char *r;       /* result string */
120         STRLEN rlen;   /* length of result string */
121         unsigned char c1, c2, c3;
122         int chunk;
123
124         CODE:
125 #if PERL_REVISION == 5 && PERL_VERSION >= 6
126         sv_utf8_downgrade(sv, FALSE);
127 #endif
128         str = SvPV(sv, rlen); /* SvPV(sv, len) gives warning for signed len */
129         len = (SSize_t)rlen;
130
131         /* set up EOL from the second argument if present, default to "\n" */
132         if (items > 1 && SvOK(ST(1))) {
133             eol = SvPV(ST(1), eollen);
134         } else {
135             eol = "\n";
136             eollen = 1;
137         }
138
139         /* calculate the length of the result */
140         rlen = (len+2) / 3 * 4;  /* encoded bytes */
141         if (rlen) {
142             /* add space for EOL */
143             rlen += ((rlen-1) / MAX_LINE + 1) * eollen;
144         }
145
146         /* allocate a result buffer */
147         RETVAL = newSV(rlen ? rlen : 1);
148         SvPOK_on(RETVAL);       
149         SvCUR_set(RETVAL, rlen);
150         r = SvPVX(RETVAL);
151
152         /* encode */
153         for (chunk=0; len > 0; len -= 3, chunk++) {
154             if (chunk == (MAX_LINE/4)) {
155                 char *c = eol;
156                 char *e = eol + eollen;
157                 while (c < e)
158                     *r++ = *c++;
159                 chunk = 0;
160             }
161             c1 = *str++;
162             c2 = *str++;
163             *r++ = basis_64[c1>>2];
164             *r++ = basis_64[((c1 & 0x3)<< 4) | ((c2 & 0xF0) >> 4)];
165             if (len > 2) {
166                 c3 = *str++;
167                 *r++ = basis_64[((c2 & 0xF) << 2) | ((c3 & 0xC0) >>6)];
168                 *r++ = basis_64[c3 & 0x3F];
169             } else if (len == 2) {
170                 *r++ = basis_64[(c2 & 0xF) << 2];
171                 *r++ = '=';
172             } else { /* len == 1 */
173                 *r++ = '=';
174                 *r++ = '=';
175             }
176         }
177         if (rlen) {
178             /* append eol to the result string */
179             char *c = eol;
180             char *e = eol + eollen;
181             while (c < e)
182                 *r++ = *c++;
183         }
184         *r = '\0';  /* every SV in perl should be NUL-terminated */
185
186         OUTPUT:
187         RETVAL
188
189 SV*
190 decode_base64(sv)
191         SV* sv
192         PROTOTYPE: $
193
194         PREINIT:
195         STRLEN len;
196         register unsigned char *str = (unsigned char*)SvPVbyte(sv, len);
197         unsigned char const* end = str + len;
198         char *r;
199         unsigned char c[4];
200
201         CODE:
202         {
203             /* always enough, but might be too much */
204             STRLEN rlen = len * 3 / 4;
205             RETVAL = newSV(rlen ? rlen : 1);
206         }
207         SvPOK_on(RETVAL);
208         r = SvPVX(RETVAL);
209
210         while (str < end) {
211             int i = 0;
212             do {
213                 unsigned char uc = index_64[NATIVE_TO_ASCII(*str++)];
214                 if (uc != INVALID)
215                     c[i++] = uc;
216
217                 if (str == end) {
218                     if (i < 4) {
219                         if (i && DOWARN)
220                             warn("Premature end of base64 data");
221                         if (i < 2) goto thats_it;
222                         if (i == 2) c[2] = EQ;
223                         c[3] = EQ;
224                     }
225                     break;
226                 }
227             } while (i < 4);
228         
229             if (c[0] == EQ || c[1] == EQ) {
230                 if (DOWARN) warn("Premature padding of base64 data");
231                 break;
232             }
233             /* printf("c0=%d,c1=%d,c2=%d,c3=%d\n", c[0],c[1],c[2],c[3]);*/
234
235             *r++ = (c[0] << 2) | ((c[1] & 0x30) >> 4);
236
237             if (c[2] == EQ)
238                 break;
239             *r++ = ((c[1] & 0x0F) << 4) | ((c[2] & 0x3C) >> 2);
240
241             if (c[3] == EQ)
242                 break;
243             *r++ = ((c[2] & 0x03) << 6) | c[3];
244         }
245
246       thats_it:
247         SvCUR_set(RETVAL, r - SvPVX(RETVAL));
248         *r = '\0';
249
250         OUTPUT:
251         RETVAL
252
253
254 MODULE = MIME::Base64           PACKAGE = MIME::QuotedPrint
255
256 #define qp_isplain(c) ((c) == '\t' || ((c) >= ' ' && (c) <= '~') && (c) != '=')
257
258 SV*
259 encode_qp(sv,...)
260         SV* sv
261         PROTOTYPE: $;$
262
263         PREINIT:
264         char *eol;
265         STRLEN eol_len;
266         STRLEN sv_len;
267         STRLEN linelen;
268         char *beg;
269         char *end;
270         char *p;
271         char *p_beg;
272         STRLEN p_len;
273
274         CODE:
275 #if PERL_REVISION == 5 && PERL_VERSION >= 6
276         sv_utf8_downgrade(sv, FALSE);
277 #endif
278         /* set up EOL from the second argument if present, default to "\n" */
279         if (items > 1 && SvOK(ST(1))) {
280             eol = SvPV(ST(1), eol_len);
281         } else {
282             eol = "\n";
283             eol_len = 1;
284         }
285
286         beg = SvPV(sv, sv_len);
287         end = beg + sv_len;
288
289         RETVAL = newSV(sv_len + 1);
290         sv_setpv(RETVAL, "");
291         linelen = 0;
292
293         p = beg;
294         while (1) {
295             p_beg = p;
296
297             /* skip past as much plain text as possible */
298             while (p < end && qp_isplain(*p)) {
299                 p++;
300             }
301             if (*p == '\n' || p == end) {
302                 /* whitespace at end of line must be encoded */
303                 while (p > p_beg && (*(p - 1) == '\t' || *(p - 1) == ' '))
304                     p--;
305             }
306
307             p_len = p - p_beg;
308             if (p_len) {
309                 /* output plain text (with line breaks) */
310                 if (eol_len) {
311                     STRLEN max_last_line = (*p == '\n' || p == end)
312                                               ? MAX_LINE         /* .......\n */
313                                               : (*(p + 1) == '\n' || (p + 1) == end)
314                                                 ? MAX_LINE - 3   /* ....=XX\n */
315                                                 : MAX_LINE - 4;  /* ...=XX=\n */
316                     while (p_len + linelen > max_last_line) {
317                         STRLEN len = MAX_LINE - 1 - linelen;
318                         if (len > p_len)
319                             len = p_len;
320                         sv_catpvn(RETVAL, p_beg, len);
321                         p_beg += len;
322                         p_len -= len;
323                         sv_catpvn(RETVAL, "=", 1);
324                         sv_catpvn(RETVAL, eol, eol_len);
325                         linelen = 0;
326                     }
327                 }
328                 if (p_len) {
329                     sv_catpvn(RETVAL, p_beg, p_len);
330                     linelen += p_len;
331                 }
332             }
333
334             if (*p == '\n' && eol_len) {
335                 sv_catpvn(RETVAL, eol, eol_len);
336                 p++;
337                 linelen = 0;
338             }
339             else if (p < end) {
340                 /* output escaped char (with line breaks) */
341                 if (eol_len && linelen > MAX_LINE - 4) {
342                     sv_catpvn(RETVAL, "=", 1);
343                     sv_catpvn(RETVAL, eol, eol_len);
344                     linelen = 0;
345                 }
346                 sv_catpvf(RETVAL, "=%02X", (unsigned char)*p);
347                 p++;
348                 linelen += 3;
349             }
350             else {
351                 assert(p == end);
352                 break;
353             }
354
355             /* optimize reallocs a bit */
356             if (SvLEN(RETVAL) > 80 && SvLEN(RETVAL) - SvCUR(RETVAL) < 3) {
357                 STRLEN expected_len = (SvCUR(RETVAL) * sv_len) / (p - beg);
358                 SvGROW(RETVAL, expected_len);
359             }
360         }
361
362         OUTPUT:
363         RETVAL
364
365 SV*
366 decode_qp(sv)
367         SV* sv
368         PROTOTYPE: $
369
370         PREINIT:
371         STRLEN len;
372         char *str = SvPVbyte(sv, len);
373         char const* end = str + len;
374         char *r;
375         char *whitespace = 0;
376
377         CODE:
378         RETVAL = newSV(len ? len : 1);
379         SvPOK_on(RETVAL);
380         r = SvPVX(RETVAL);
381         while (str < end) {
382             if (*str == ' ' || *str == '\t') {
383                 if (!whitespace)
384                     whitespace = str;
385                 str++;
386             }
387             else if (*str == '\r' && (str + 1) < end && str[1] == '\n') {
388                 str++;
389             }
390             else if (*str == '\n') {
391                 whitespace = 0;
392                 *r++ = *str++;
393             }
394             else {
395                 if (whitespace) {
396                     while (whitespace < str) {
397                         *r++ = *whitespace++;
398                     }
399                     whitespace = 0;
400                 }
401                 if (*str == '=') {
402                     if ((str + 2) < end && isxdigit(str[1]) && isxdigit(str[2])) {
403                         char buf[3];
404                         str++;
405                         buf[0] = *str++;
406                         buf[1] = *str++;
407                         buf[2] = '\0';
408                         *r++ = (char)strtol(buf, 0, 16);
409                     }
410                     else {
411                         /* look for soft line break */
412                         char *p = str + 1;
413                         while (p < end && (*p == ' ' || *p == '\t'))
414                             p++;
415                         if (p < end && *p == '\n')
416                             str = p + 1;
417                         else if ((p + 1) < end && *p == '\r' && *(p + 1) == '\n')
418                             str = p + 2;
419                         else
420                             *r++ = *str++; /* give up */
421                     }
422                 }
423                 else {
424                     *r++ = *str++;
425                 }
426             }
427         }
428         if (whitespace) {
429             while (whitespace < str) {
430                 *r++ = *whitespace++;
431             }
432         }
433         *r = '\0';
434         SvCUR_set(RETVAL, r - SvPVX(RETVAL));
435
436         OUTPUT:
437         RETVAL
438
439
440 MODULE = MIME::Base64           PACKAGE = MIME::Base64