Commit 330bde31 authored by Jan Idzikowski's avatar Jan Idzikowski
Browse files

fixed wrap at column in base64-encode-file

add #\Return#\Newline after each column
parent f78d701a
...@@ -104,11 +104,11 @@ ...@@ -104,11 +104,11 @@
(generate-message-header (generate-message-header
sock sock
:boundary boundary :boundary boundary
:content-type (format nil "~A;~%~tname*=~A;~%~tname=~S" :content-type (format nil "~A;~%~tname*=~A;~%~tname=\"~A\""
(attachment-mime-type attachment) (attachment-mime-type attachment)
quoted-name* quoted-name) quoted-name* quoted-name)
:content-transfer-encoding "base64" :content-transfer-encoding "base64"
:content-disposition (format nil "attachment; filename*=~A; filename=~S" :content-disposition (format nil "attachment; filename*=~A; filename=\"~A\""
quoted-name* quoted-name)))) quoted-name* quoted-name))))
(defun send-end-marker (sock boundary) (defun send-end-marker (sock boundary)
...@@ -158,78 +158,45 @@ ...@@ -158,78 +158,45 @@
(defun base64-encode-file (file-in sock (defun base64-encode-file (file-in sock
&key &key
(buffer-size 256) ;; in KB (buffer-size 256) ;; in KB
(wrap-at-column 70)) (wrap-at-column 76))
"Encodes the file contents given by file-in, which can be of any form appropriate to with-open-file, and write the base-64 encoded version to sock, which is a socket. "Encodes the file contents given by file-in, which can be of any form appropriate to with-open-file,
and write the base-64 encoded version to sock, which is a socket.
Buffer-size, given in KB, controls how much of the file is processed and written to the socket at one time. A buffer-size of 0, processes the file all at once, regardless of its size. One will have to weigh the speed vs, memory consuption risks when chosing which way is best. Buffer-size is ignored
Wrap-at-column controls where the encode string is divided for line breaks." Wrap-at-column controls where the encode string is divided for line breaks,
it is always set to a multiple of 3."
(declare (ignore buffer-size))
(when (probe-file file-in) (when (probe-file file-in)
;;-- open filein --------- ;;-- open filein ---------
(print-debug (format nil "base64-encode-file ~A" file-in))
(with-open-file (strm-in file-in (with-open-file (strm-in file-in
:element-type '(unsigned-byte 8)) :element-type '(unsigned-byte 8))
(let* ((;; convert buffer size given to bytes (let* ((flength (file-length strm-in))
;; or compute bytes based on file (columns (* (truncate (/ wrap-at-column 3)) 3))
max-buffer-size (r 0)
(if (zerop buffer-size) (n 0))
(file-length strm-in) (loop while (< (file-position strm-in) flength)
;; Ensures 64 bit encoding is properly for buffer = (make-array 3
;; divided so that filler :element-type '(unsigned-byte 8))
;; characters are not required between chunks do
(* 24 (truncate (/ (* buffer-size 1024) 24))))) (loop for i from 0 to 2 do
(column-count 0)
(eof? nil)
(buffer (make-array max-buffer-size
:element-type '(unsigned-byte 8))))
(loop
(print-debug (format nil "~%Process attachment ~a~%" file-in))
(let* ((;; read a portion of the file into the buffer arrary and
;; returns the index where it stopped
byte-count (dotimes (i max-buffer-size max-buffer-size)
(let ((bchar (read-byte strm-in nil 'EOF))) (let ((bchar (read-byte strm-in nil 'EOF)))
(if (eql bchar 'EOF) (if (eql bchar 'EOF)
(progn (progn
(setq eof? t) (setf r i)
(return i)) (return))
(setf (aref buffer i) bchar)))))) (setf (aref buffer i) bchar))))
(if (zerop buffer-size)
;; send file all at once to socket.
#+allegro #+allegro
(write-string (excl:usb8-array-to-base64-string (write-sequence (excl:usb8-array-to-base64-string
buffer wrap-at-column) sock) (if (> r 0) (subseq buffer 0 r) buffer) :wrap-at-column nil)
sock)
#-allegro #-allegro
(cl-base64:usb8-array-to-base64-stream (cl-base64:usb8-array-to-base64-stream
buffer sock :columns wrap-at-column) (if (> r 0) (subseq buffer 0 r) buffer) sock :columns 0)
;; otherwise process file in chunks. (incf n 3)
;; The extra encoded-string, (when (= (mod n columns) 0)
;; and its subseq functions are brute force methods (setf n 0)
;; to properly handle the wrap-at-column feature (write-blank-line sock)))
;; between buffers.
;; Not the most efficient way,
;; but it works and uses existing functions
;; in the cl-base64 package.
(let* ((;; drops off extra elements that were not filled in in reading, this is important for lisp systems that default a value into
;; the array when it is created. -- ie Lispworks, SBCL
trimmed-buffer (if eof?
(subseq buffer 0 byte-count)
buffer))
(encoded-string
#+allegro
(excl:usb8-array-to-base64-string
trimmed-buffer)
#-allegro
(cl-base64:usb8-array-to-base64-string
trimmed-buffer)))
(loop for ch across encoded-string
do (progn
(write-char ch sock)
(incf column-count)
(when (= column-count wrap-at-column)
(setq column-count 0)
(write-char #\Newline sock))))))
(force-output sock) (force-output sock)
(print-debug (format nil "~% Eof is ~a~%" eof?)) (write-blank-line sock)))))
(when (or (zerop buffer-size)
eof?)
(write-blank-line sock)
(return))))))))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment