- (len (length buff))
- (i 0)
- (p (post-office-socket mailbox))
- (ch nil)
- (whole-count)
- )
-
- (handler-case
- (flet ((grow-buffer (size)
- (let ((newbuff (get-line-buffer size)))
- (dotimes (j i)
- (setf (schar newbuff j) (schar buff j)))
- (free-line-buffer buff)
- (setq buff newbuff)
- (setq len (length buff)))))
-
- ;; increase the buffer to at least size
- ;; this is somewhat complex to ensure that we aren't doing
- ;; buffer allocation within the with-timeout form, since
- ;; that could trigger a gc which could then cause the
- ;; with-timeout form to expire.
- (loop
-
- (if* whole-count
- then ; we should now read in this may bytes and
- ; append it to this buffer
- (multiple-value-bind (ans this-count)
- (get-block-of-data-from-server mailbox whole-count)
- ; now put this data in the current buffer
- (if* (> (+ i whole-count 5) len)
- then ; grow the initial buffer
- (grow-buffer (+ i whole-count 100)))
-
- (dotimes (ind this-count)
- (setf (schar buff i) (schar ans ind))
- (incf i))
- (setf (schar buff i) #\^b) ; end of inset string
- (incf i)
- (free-line-buffer ans)
- (setq whole-count nil)
- )
- elseif ch
- then ; we're growing the buffer holding the line data
- (grow-buffer (+ len 200))
- (setf (schar buff i) ch)
- (incf i))
-
-
- (block timeout
- (with-timeout ((timeout mailbox)
- (po-error :timeout
- :format-control "imap server failed to respond"))
- ;; read up to lf (lf most likely preceeded by cr)
- (loop
- (setq ch (read-char p))
- (if* (eq #\linefeed ch)
- then ; end of line. Don't save the return
- (if* (and (> i 0)
- (eq (schar buff (1- i)) #\return))
- then ; remove #\return, replace with newline
- (decf i)
- (setf (schar buff i) #\newline)
- )
- ;; must check for an extended return value which
- ;; is indicated by a {nnn} at the end of the line
- (block count-check
- (let ((ind (1- i)))
- (if* (and (>= i 0) (eq (schar buff ind) #\}))
- then (let ((count 0)
- (mult 1))
- (loop
- (decf ind)
- (if* (< ind 0)
- then ; no of the form {nnn}
- (return-from count-check))
- (setf ch (schar buff ind))
- (if* (eq ch #\{)
- then ; must now read that many bytes
- (setf (schar buff ind) #\^b)
- (setq whole-count count)
- (setq i (1+ ind))
- (return-from timeout)
- elseif (<= #.(char-code #\0)
- (char-code ch)
- #.(char-code #\9))
- then ; is a digit
- (setq count
- (+ count
- (* mult
- (- (char-code ch)
- #.(char-code #\0)))))
- (setq mult (* 10 mult))
- else ; invalid form, get out
- (return-from count-check)))))))
-
-
- (return-from get-line-from-server
- (values buff i))
- else ; save character
- (if* (>= i len)
- then ; need bigger buffer
- (return))
- (setf (schar buff i) ch)
- (incf i)))))))
+ (len (length buff))
+ (i 0)
+ (p (post-office-socket mailbox))
+ (ch nil)
+ (whole-count)
+ )
+
+ (handler-case
+ (flet ((grow-buffer (size)
+ (let ((newbuff (get-line-buffer size)))
+ (dotimes (j i)
+ (setf (schar newbuff j) (schar buff j)))
+ (free-line-buffer buff)
+ (setq buff newbuff)
+ (setq len (length buff)))))
+
+ ;; increase the buffer to at least size
+ ;; this is somewhat complex to ensure that we aren't doing
+ ;; buffer allocation within the with-timeout form, since
+ ;; that could trigger a gc which could then cause the
+ ;; with-timeout form to expire.
+ (loop
+
+ (if* whole-count
+ then ; we should now read in this may bytes and
+ ; append it to this buffer
+ (multiple-value-bind (ans this-count)
+ (get-block-of-data-from-server mailbox whole-count)
+ ; now put this data in the current buffer
+ (if* (> (+ i whole-count 5) len)
+ then ; grow the initial buffer
+ (grow-buffer (+ i whole-count 100)))
+
+ (dotimes (ind this-count)
+ (setf (schar buff i) (schar ans ind))
+ (incf i))
+ (setf (schar buff i) #\^b) ; end of inset string
+ (incf i)
+ (free-line-buffer ans)
+ (setq whole-count nil)
+ )
+ elseif ch
+ then ; we're growing the buffer holding the line data
+ (grow-buffer (+ len 200))
+ (setf (schar buff i) ch)
+ (incf i))
+
+
+ (block timeout
+ (with-timeout ((timeout mailbox)
+ (po-error :timeout
+ :format-control "imap server failed to respond"))
+ ;; read up to lf (lf most likely preceeded by cr)
+ (loop
+ (setq ch (read-char p))
+ (if* (eq #\linefeed ch)
+ then ; end of line. Don't save the return
+ (if* (and (> i 0)
+ (eq (schar buff (1- i)) #\return))
+ then ; remove #\return, replace with newline
+ (decf i)
+ (setf (schar buff i) #\newline)
+ )
+ ;; must check for an extended return value which
+ ;; is indicated by a {nnn} at the end of the line
+ (block count-check
+ (let ((ind (1- i)))
+ (if* (and (>= i 0) (eq (schar buff ind) #\}))
+ then (let ((count 0)
+ (mult 1))
+ (loop
+ (decf ind)
+ (if* (< ind 0)
+ then ; no of the form {nnn}
+ (return-from count-check))
+ (setf ch (schar buff ind))
+ (if* (eq ch #\{)
+ then ; must now read that many bytes
+ (setf (schar buff ind) #\^b)
+ (setq whole-count count)
+ (setq i (1+ ind))
+ (return-from timeout)
+ elseif (<= #.(char-code #\0)
+ (char-code ch)
+ #.(char-code #\9))
+ then ; is a digit
+ (setq count
+ (+ count
+ (* mult
+ (- (char-code ch)
+ #.(char-code #\0)))))
+ (setq mult (* 10 mult))
+ else ; invalid form, get out
+ (return-from count-check)))))))
+
+
+ (return-from get-line-from-server
+ (values buff i))
+ else ; save character
+ (if* (>= i len)
+ then ; need bigger buffer
+ (return))
+ (setf (schar buff i) ch)
+ (incf i)))))))