;; data/core/net.scm - utility procedures for network programming
;;
;; Copyright (C) 2000 Martin Grabmueller <mgrabmue@cs.tu-berlin.de>
;;
;; This is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; 
;; This software 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 General Public License for more details.
;; 
;; You should have received a copy of the GNU General Public License
;; along with this package; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.  

(define-module (core net))

(export base64-encode sockaddr:family sockaddr:addr sockaddr:port)


;; Accesor functions for socket address structures.

(define (sockaddr:family a) (vector-ref a 0))
(define (sockaddr:addr a)   (vector-ref a 1))
(define (sockaddr:port a)   (vector-ref a 2))


(define arithmetic-shift ash)
(define linefeed #\)

(define (base64-encode src)
					; Always includes a terminator
  (let* ((len (string-length src))
	 (new-len (let ((l (add1 (ceiling (* len (/ 8 6))))))
					; Break l into 72-character lines.
					; Insert CR/LF between each line.
		    (ceiling (+ l (* (quotient l 72) 2)))))
	 (dest (make-string new-len #\0))
	 (char-map (list->vector
		    (let ((each-char (lambda (s e)
				       (let loop ((l '())(i (char->integer e)))
					 (if (= i (char->integer s))
					     (cons s l)
					     (loop (cons (integer->char i)
							 l)
						   (sub1 i)))))))
		      (append
		       (each-char #\A #\Z)
		       (each-char #\a #\z)
		       (each-char #\0 #\9)
		       (list #\+ #\/))))))
;    (write-line len)
;    (write-line new-len)
;    (write-line char-map)
    (let loop ((bits 0)(v 0)(col 0)(srcp 0)(destp 0))
      (cond
       ((= col 72)
					; Insert CRLF
	(string-set! dest destp #\return)
	(string-set! dest (add1 destp) linefeed)
;#\linefeed)
	(loop bits
	      v
	      0
	      srcp
	      (+ destp 2)))
       ((and (= srcp len)
	     (<= bits 6))
					; That's all, folks.
					; Write the last few bits.
	(begin
	  (string-set! dest destp (vector-ref char-map (arithmetic-shift v (- 6 bits))))
	  (add1 destp))
	(if (= col 71)
					; Have to write CRLF before terminator
	    (begin
	      (string-set! dest (+ destp 1) #\return)
	      (string-set! dest (+ destp 2) linefeed)
;#\linefeed)
	      (string-set! dest (+ destp 3) #\=))
	    (string-set! dest (add1 destp) #\=))
	dest)
       ((< bits 6)
					; Need more bits.
	(loop (+ bits 8)
	      (bitwise-ior (arithmetic-shift v 8)
			   (char->integer (string-ref src srcp)))
	      col
	      (add1 srcp)
	      destp))
       (else
					; Write a char.
	(string-set! dest destp (vector-ref char-map (arithmetic-shift v (- 6 bits))))
	(loop (- bits 6)
	      (bitwise-and v (sub1 (arithmetic-shift 1 (- bits 6))))
	      (add1 col)
	      srcp
	      (add1 destp)))))))


