Guile and Leafnode

Here's how you can use Guile filter your news feed, using the Leafnode news server.

Rename the main function in fetchnews.c to inner_main and add the following suffix to the file.

#include <libguile.h>
 
int main(int argc,char *argv[])
{
     scm_boot_guile(argc, argv, inner_main, NULL);
     return 0;
}

CPPFLAGS =  -Ipcre `guile-config compile`
LDFLAGS = `guile-config link`

#include "leafnode.h"
#include <sys/types.h>
#include <ctype.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <syslog.h>

#include <libguile.h>


typedef struct {
  SCM proc;
  SCM args;
} DATA, *PDATA;


static SCM loadfilters(void *filename)
{
     return scm_c_primitive_load((char *) filename);
}

static SCM loadfilters_with_catch(char *filename)
{
     scm_internal_catch(SCM_BOOL_T,
			loadfilters,
			(void *) filename,
			scm_handle_by_message_noexit,
			NULL);
     return SCM_BOOL_T;
}

void readfilter(char *fifi)
{
     SCM b = loadfilters_with_catch(fifi);
     
     if (SCM_FALSEP(b)) {
	  syslog(LOG_ERR, "Unable to load filterfile %s: %m", fifi);
	  printf("Unable to load filterfile %s\n", fifi);
	  return;
     }
}

SCM scm_dofilter(void *h)
{
     SCM headers = scm_makfrom0str((char *) h);
     SCM var = scm_c_lookup("dofilter");

     if (SCM_NFALSEP(scm_variable_p(var))) {
	  SCM proc = SCM_VARIABLE_REF(var);
	  if (SCM_NFALSEP(scm_procedure_p(proc)))
	       return scm_apply_1(proc, headers, SCM_EOL);
     }

     return SCM_BOOL_F;
}

int dofilter(char *headers)
{
     SCM r = scm_internal_catch(SCM_BOOL_T,
				scm_dofilter,
				headers,
				scm_handle_by_message_noexit,
				NULL);

     return SCM_NFALSEP(r);
}

;;; -*- scheme -*-

(use-modules
    (srfi srfi-1)
    (ice-9 format)
    (ice-9 regex))

(define *filters* '())

(define (define-filter regex thunk)
    (set! *filters*
	(cons
	    (cons (make-regexp regex) thunk)
	    *filters*)))

(define (unzip-pair p)
    (lambda (x)
	(if (pair? x)
	    (p (car x) (cdr x)))))

(define (dofilter h)
    (define (run-filter regex action)
	(let ((m (regexp-exec regex h)))
	    (if m
		(action m))))
    (catch 'trigger
	(lambda ()
	    (for-each (unzip-pair run-filter) *filters*)
	    #f)
	(lambda (key val)
	    val)))

(define *from* #f)

(define-filter
    "^From: (.*)"
    (lambda (m)
	(set! *from* (match:substring m 1))))

(define (make-result b)
    (lambda (syms)
	(format #t "filter: ~a ~a ~a~%" ; for debugging
	    (if b 'kill 'keep)
	    syms
	    *from*)
	(throw 'trigger b)))

(define kill (make-result #t))
(define keep (make-result #f))

(define *seen* '())

(define (reset-seen!)
    (set! *seen* '()))

(define (seen! sym)
    (set! *seen* (cons sym *seen*)))

(define (seen? sym)
    (memq sym *seen*))

(define-filter "^Path:.*"
    (lambda (m)
	(reset-seen!)
	#f))

(define *triggers* '())

(define (make-trigger syms action)
    (lambda ()
	(if (every seen? syms)
	    (action syms)
	    #f)))

(define (trigger action . syms)
    (set! *triggers*
	(cons
	    (make-trigger syms action)
	    *triggers*)))


(define-filter "^Xref:.*"
    (lambda (m)
	(for-each
	    (lambda (thunk) (thunk))
	    (reverse *triggers*))
	(reset-seen!)
	#f))

(define (see field)
    (lambda (name sym)
	(define-filter
	    (string-append "^" field ":.*" name)
	    (lambda (m)
		(seen! sym)))))

(define seen-from (see "From"))
(define seen-ref (see "References"))
(define seen-ng (see "Newsgroups"))

(define (seen-from-ref name sym)
    (seen-from name sym)
    (seen-ref name sym))

;;; The following is specific to the newsgroups that I read.
;;; In alt.slack, I'm only interested in posts by two people
;;; and their replies.

(seen-from-ref "modemac" 'ok)
(seen-from-ref "stang" 'ok)
(seen-from-ref "[Nn]erdware" 'ok)
(seen-ng "alt.slack" 'slack)
(trigger keep 'slack 'ok)
(trigger kill 'slack)

;;; In comp.lang.lisp, I'm even more selective.

(seen-from "cbbrowne" 'ok)
(seen-from "pitman" 'ok)
(seen-ng "comp.lang.lisp" 'lisp)
(trigger keep 'lisp 'ok)
(trigger kill 'lisp)