One of the students in CSCS set up a Planet aggregator for the CSCS weblogs. As cs-ed.org runs on a small server, I’d rather not have a cron job running to do updates; instead, I prefer the pub/sub model, where the students with weblogs ping our server to update the aggregator.

Most weblogging tools have the ability to ping a weblogs.com-style XML-RPC endpoint. I thought I’d dissect how I implemented this, as it captures some of what I like about programming in Scheme.

I started with the bare minimum for an XML-RPC CGI process running under Apache:

#!/usr/local/bin/mzscheme -gqr

(require
 (lib "xmlrpc.ss" "xmlrpc"))

(xmlrpc-handlers

 (handler 'weblogUpdates.ping '...)
 )

I knew I had to provide the weblogUpdates.ping handler, as that’s part of the “spec”. Unfortunately, the spec calls for “optional” parameters, which the actual transport doesn’t support—but, I can fake it reasonably well with case-lambda. So, I’ll define my ping method, which will be exported to the outside world as weblogUpdates.ping.

#!/usr/local/bin/mzscheme -gqr

(require
 (lib "xmlrpc.ss" "xmlrpc"))
(xmlrpc-handlers

 (define ping
   (case-lambda
    [()
     '...]
    [(name url)
     '...]
    [(name url changeurl)
     '...]
    [(name url changeurl catname)
     '... ]))

 (handler 'weblogUpdates.ping ping)
 )

This also handles a non-specified case, which is when the procedure is called with no arguments; I added this for my own testing, and it happens to fit the needs of the particular project.

Now, when someone pings the server, I’d like to

1. log the event, and
2. run the aggregator

I actually started with the aggregator, but here, I’ll start with the logging. That would have made more sense, anyway.

#!/usr/local/bin/mzscheme -gqr

(require
 (lib "xmlrpc.ss" "xmlrpc")
 (lib "date.ss"))

(xmlrpc-handlers

 (define ping
   (case-lambda
    [()
     '... ]
    [(name url)
     '... ]
    [(name url changeurl)
     '... ]
    [(name url changeurl catname)
     (let ([op (open-output-file "ping.log" 'append)])
       (fprintf op "(~a (ping ~a ~a ~a ~a) (date ~a))~n"
                (current-seconds)
                name url changeurl catname
                (date->string (seconds->date (current-seconds)) #t))
       (close-output-port op))
     ]))

 (handler 'weblogUpdates.ping ping)
 )

It’s not pretty, but it gives me something to look at if I need to, or if I want to have a sense for how often people are pinging the aggregator. Because I want to have a human-readable form of the date, I have to import the date.ss library.

To run the aggregator, I need to import the process.ss library that lets me make external system calls.

#!/usr/local/bin/mzscheme -gqr

(require
 (lib "xmlrpc.ss" "xmlrpc")
 (lib "process.ss")
 (lib "date.ss"))

(xmlrpc-handlers

 (define ping
   (case-lambda
    [()
     '... ]
    [(name url)
     '... ]
    [(name url changeurl)
     '... ]
    [(name url changeurl catname)
     (let ([op (open-output-file "ping.log" 'append)])
       (fprintf op "(~a (ping ~a ~a ~a ~a) (date ~a))~n"
                (current-seconds)
                name url changeurl catname
                (date->string (seconds->date (current-seconds)) #t))
       (close-output-port op))

     (current-directory "/planet/")
     (system "python planet.py config.ini")

     ]))

 (handler 'weblogUpdates.ping ping)
 )

I’ve omitted the exact path in this particular example. Now, I fill in the ... I’ve had laying around, so that I have reasonable values for parameters that aren’t included. Also, the “spec” says that I should return a hash table indicating success or failure. I’m a bit lazy today, so I’m going to just indicate success all the time. I may revisit this and indicate success or failure based on the actual result of the system call.

#!/usr/local/bin/mzscheme -gqr

(require
 (lib "xmlrpc.ss" "xmlrpc")
 (lib "process.ss")
 (lib "date.ss"))

(xmlrpc-handlers

 (define ping
   (case-lambda
    [()
     (ping "none" "none" "none" "none")]
    [(name url)
     (ping name url url "none")]
    [(name url changeurl)
     (ping name url changeurl "none")]
    [(name url changeurl catname)
     (let ([op (open-output-file "ping.log" 'append)])
       (fprintf op "(~a (ping ~a ~a ~a ~a) (date ~a))~n"
                (current-seconds)
                name url changeurl catname
                (date->string (seconds->date (current-seconds)) #t))
       (close-output-port op))

     (current-directory "/data/www/cs-ed.org/cscs/planet/")
     (system "python planet.py config.ini")

     (let ([h (make-hash-table)])
       (hash-table-put! h 'flerror #f)
       (hash-table-put! h 'message "no error")
       h
       )]))

 (handler 'weblogUpdates.ping ping)
 )

And that’s it! In a handful of minutes, we have an XML-RPC endpoint that lets students tell the aggregator when they’ve updated their weblog.