; Copyright (C) 2006, Ephemeral Security, LLC
; 
; This library is free software; you can redistribute it and/or modify it 
; under the terms of the GNU Lesser General Public License, version 2.1
; as published by the Free Software Foundation.
; 
; This library is distributed in the hope that it will be useful, but WITHOUT 
; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 
; FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License 
; for more details.
; 
; You should have received a copy of the GNU Lesser General Public License 
; along with this library; if not, write to the Free Software Foundation, 
; Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 

(module "lib/block-filter")
(import "lib/filter")
(import "lib/buffer-channel")

(export block-merge-filter block-split-filter fragment-filter)

(define (pad-length message-length block-size)
  ; flash -- the incomplete final block of a message.
  
  (define flash-size (remainder message-length block-size))
  (if (= 0 flash-size)
    0
    (- block-size flash-size)))

; Collates a sequence of blocks, as generated by block-split-filter, into
; the original message, trimming off any padding from the last block.
;
; The first block must start with a four byte network order length.
;
; b-m-f employs buffer-channel2 to handle irregular blocks, making it useful
; for decrypting messages that may have been fragmented by network MTU.

(define-filter (block-merge-filter block-size)
  (define read (buffer-channel/2 in out))
  (define (read-quad)
    (string-read-quad! (read 4)))

  (forever
    (define message-length (read-quad))
    (define message (read message-length))
    (send message out)
    (read (pad-length (+ 4 message-length) block-size))))

; Breaks a string message into a sequence of one or more blocks, leading the 
; first block with its length encoded in four bytes, network order.
; 
; If the message is not an even multiple of the block size, the final block
; will be padded with data collected from the default entropy source.

(define-filter (block-split-filter block-size)
  (forever
    (define message (wait in))

    (cond
      ((string? message)
       (string-prepend! message (quad->string (string-length message)))
       (until (< (string-length message) block-size)
              (send (string-read! message block-size) out))
       (unless (empty-string? message)
         (string-append! message 
                         (random-string (- block-size 
                                           (string-length message))))
         (send message out)))
      (else
        (send message out)))))

(define-filter (fragment-filter block-size)
  (define buffer (make-string 256))

  (define (feed)
    (while (>= (string-length buffer) block-size)
      (send (string-read! buffer block-size) out)))

  (forever
    (define evt (wait in))
    (cond ((string? evt)
           (string-append! buffer evt)
           (feed))
          (else
            (send evt out)))))

