;;;; -*-Mode:LISP; Package:LISP; Base:10; Syntax:ISLISP -*-
;;;; Title:     nntp.lsp
;;;; Author:    C. Jullien
;;;; License:   New BSD license
;;;; CVS:       "$Id: nntp.lsp,v 1.16 2013/06/18 05:21:56 jullien Exp $"

;;;     nntp.lsp:       Network News Transfer Protocol
;;;     See RFC 0977
;;;     NOTE: This code is *NOT* fully tested.

;;; Usage: (nntp-get "news.wanadoo.fr" "comp.lang.lisp")

(require "setf")
(require "datetime")
(require "sysinfo")

(defpackage #:nntp
   (:use    #:openlisp)
   (:export #:nntp-get))

(in-package #:nntp)

(defconstant +nntp-nl+   (convert '(#\Carriage-Return #\Newline) <string>))

(defglobal *nntp-port*   119)
(defglobal *nntp-debug*  t)

(defun nntp-format (so fmt &rest args)
   (when *nntp-debug*
         (apply #'format (standard-output) fmt args))
   (apply #'format so fmt args))

(defun nntp-request (so fmt &rest args)
   (when *nntp-debug*
         (apply #'format (standard-output) fmt args)
         (format-fresh-line (standard-output)))
   (apply #'format so fmt args)
   (send so +nntp-nl+ (length +nntp-nl+)))

(defun nntp-get-status (so)
   ;; "XXX ..." depends on the status code.
   (let ((reply nil))
        (setf reply (read-line so nil nil))
        (when *nntp-debug*
              (format (standard-output) "~a~%" reply))

(defun nntp-check-status (so status)
   ;; "XXX ..." depends on the status code.
   (let ((reply (nntp-get-status so)))
        (unless (and (stringp status) (eq (string-index status reply) 0))
                (error "NNTP error: ~a was expected '~a'~%" status reply))

(defun nntp-get-text (so)
   (let ((reply nil)
         (text  nil))
        (while (and (setf reply (read-line so nil nil))
                    (not (equal reply ".")))
               (push reply text)
               (when *nntp-debug*
                     (format (standard-output) "~a~%" reply)))

(defun nntp-get (server group &rest max)
   (with-client-socket (socket (get-host-address server) *nntp-port* 'tcp)
         (let ((res   nil)
               (last  0)
               (first 0))
              (if max
                  (setf max (car max))
                  (setf max 10))
              ;; get connection status
              (nntp-check-status socket "200")
              ;; initiate negociation
              (nntp-request socket "GROUP ~a" group)
              (setf res (string-split
                                '(#\Space #\Tab)
                                 (nntp-check-status socket "211")))
              (when (>= (length res) 4)
                    (setf first (read-from-string (nth 2 res)))
                    (setf last  (read-from-string (nth 3 res)))
                    (for ((i 0 (1+ i)))
                         ((or (= i max) (< (- last i) first)))
                         (let ((item (- last i)))
                              (nntp-request socket "ARTICLE ~a" item)
                              (setf res (nntp-get-status socket))
                              (when (< (read-from-string res) 300)
                                    (setf res (nntp-get-text socket)))
                              (mapc #'print res))))
              (nntp-request socket "QUIT")
              (nntp-check-status socket "205")

(provide "nntp")