blob: 394085d3e6876130ab18ac9e6e9049f543b84cb0 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
#!/bin/sh
#| -*- scheme -*-
exec csi -s $0 "$@"
Copyright (C) 2022 C Duckworth <acdw@acdw.net>
An implementation of the QOTD protocol (RFC 865)
|#
(import (chicken condition)
(chicken file)
(chicken io)
(chicken port)
(chicken process)
(chicken process-context)
(chicken tcp))
(define qotd-version 0.1)
(define qotd-port 17)
(define qotd-backlog 100)
(define qotd-host "localhost")
(define qotd-file "/tmp/qotd")
(define (usage)
(with-output-to-port (current-error-port)
(lambda ()
(display "Usage: qotd [-host HOST] [-port PORT] [-backlog LINES] [-file FILE]\n")
(display "Default -host: localhost\n")
(display "Default -port: 17\n")
(display "Default -backlog: 100\n")
(display "Default -file: /tmp/qotd\n"))))
(define (handle quote listener)
(define-values (i o) (tcp-accept listener))
(write-string (quote) #f o)
(close-input-port i)
(close-output-port o))
(define (read-output command-line) ; unused
(call-with-input-pipe command-line
(lambda (port)
(read-string #f port))))
(define (file-read* filename)
(if (and (file-exists? filename)
(file-readable? filename))
(with-input-from-file filename read-string)
#f))
(define (ensure-final-newline str)
(cond ((char=? (string-ref str (- (string-length str) 1)) #\newline) str)
(else (string-append str "\n"))))
(define (main arguments)
(with-output-to-port (current-error-port)
(lambda ()
(display "Welcome to QOTD v.")
(display qotd-version)
(newline)))
(let argloop ((args arguments))
(cond ((null? args) #f)
(else (cond
((or (member "-help" args)
(member "-h" args))
(usage)
(exit 0))
((member "-port" args)
=> (lambda (a) (set! qotd-port (string->number (cadr a)))))
((member "-host" args)
=> (lambda (a) (set! qotd-host (cadr a))))
((member "-backlog" args)
=> (lambda (a) (set! qotd-backlog (string->number (cadr a)))))
((member "-file" args)
=> (lambda (a) (set! qotd-file (cadr a)))))
(argloop (cdr args)))))
(with-output-to-port (current-error-port)
(lambda ()
(display "QOTD Port: ")
(display qotd-port)
(newline)
(display "QOTD Backlog: ")
(display qotd-backlog)
(newline)
(display "QOTD Server: ")
(display qotd-host)
(newline)
(display "QOTD File: ")
(display qotd-file)
(newline)))
(let loop ((listener (tcp-listen qotd-port qotd-backlog qotd-host)))
(handle (lambda () (let ((qotd (ensure-final-newline (file-read* qotd-file))))
(if qotd qotd "Oop\n")))
listener)
(loop listener)))
(main (command-line-arguments))
|
