I came into work today and found that
inews had stopped working, cutting me off from participating in
news:comp.lang.tcl
to my great annoyance. So I started posting by connecting directly to the NNTP server, but that is a bit of a drag. So I wrote this script to automate the process. Enjoy!
Donal FellowsPS: Feel free to augment it with the bits that are missing (password negotiation for servers that require authentication, and better
MIME handling are the main missing features.)
#!/bin/sh
# This is a UNIX-specific script; it will not work on other platforms... \
exec tclsh $0 ${1+"$@"}
### This script is a simple replacement for inews, the standard
### Unix USENET posting command. It does simple, though easy to
### customise, header processing, and it makes sure that the body
### of messages gets sent through unmangled. Or something like that.
set host myNNTPserver;# I've got to set it to *something*
if {[info exist env(NNTPSERVER)]} {set host $env(NNTPSERVER)}
set port nntp;# NNTP port, which is 119 normally
# Guess the email address. This works for me...
set emailAddress $env(LOGNAME)@[exec /usr/bin/domainname]
# And guess what I want to be known as. Again, this works for me...
set realName $env(NAME)
# Ought to process arguments here!
proc capitalise1 {word} {
set c0 [string index $word 0]
set cr [string range $word 1 end]
return [string toupper $c0][string tolower $cr]
}
proc capitalise {string} {
set result {}
foreach word [split $string "-"] {lappend result [capitalise1 $word]}
join $result "-"
}
# Read NNTP response message. Primitive, but works!
proc readResponse {{expected ""}} {
global nntp
upvar code code message message
flush $nntp
set len [gets $nntp line]
while {$len == 0} {
set len [gets $nntp line]
}
if {$len < 0} {
error "OOPS! Unexpected closure of NNTP socket"
}
if {![regexp {^([0-9]+) +(.*)} $line => code message]} {
error "OOPS! Bad response: $line"
}
if {[string length $expected] && [string compare $code $expected]} {
return -code error "Unexpected reply: $message"
}
}
# Post a message. Note that the headers are an array, and the body a list.
proc post {} {
global nntp head body
puts $nntp "post"
readResponse
if {$code != 340} {
return -code error "Cannot post: $message"
}
foreach {header value} [array get head] {
puts $nntp "[capitalise $header]: [string trim $value]"
}
puts $nntp ""
foreach line $body {
if {[string index $line 0] == "."} {
puts $nntp ".$line"
} else {
puts $nntp $line
}
}
puts $nntp .
readResponse
if {$code != 240} {
return -code error "Failed to post: $message"
}
}
# Connecting to, and disconnecting from an NNTP server.
proc connect {host {port 119}} {
global nntp
set nntp [socket $host $port]
readResponse 200
}
proc quit {} {
global nntp
puts $nntp "quit"
readResponse 205
close $nntp
}
# Split up a message in pseudo-RFC822 format for more processing
proc splitMessage {message} {
global head body
set inBody 0
array set head {}
set body {}
set lastheader {}
foreach line [split $message "\n"] {
if {$inBody} {
lappend body $line
} elseif {[string length $line] == 0} {
set inBody 1
} elseif {[regexp {^([^ :]+): +(.*)} $line => header value]} {
set header [string tolower $header]
set value [string trim $value]
if {[string length $value]} {
set head($header) "$value "
}
set lastheader $header
} else {
append head($lastheader) "[string trim $line] "
}
}
}
# Specify that the given header must be specified in the input message
proc needHeader {header} {
global head
if {![info exist head([string tolower $header])]} {
return -code error "Required header \"${header}:\" is missing"
}
}
# Add the given header to the message to be posted
proc addHeader {header value} {
global head
set header [string tolower $header]
if {![info exist head($header)]} {
set head($header) $value
}
}
# Debugging wrapped up for neatness!
proc DEBUG {} {
global head body
parray head
puts "--------------------------------"
puts [join $body "\n"]
exit 0
}
# ---------------------------------------------------------------------
# Now we get to the business end of things. We start by reading in the
# message to be posted.
splitMessage [string trimright [read stdin]]
# Some headers are required
needHeader Newsgroups
needHeader Subject
# And others we can supply
addHeader From "$realName <$emailAddress>"
addHeader Organization \
"Department of Computer Science, University of Manchester"
addHeader "X-Posting-Engine" "postnntp v0.02a on Tcl [info patchlevel]"
# My news-server handles the adding of the Lines: header itself
#addHeader Lines [llength $body]
addHeader "Content-Type" "text/plain; charset=iso-8859-1"
# If you want to add MIME encoding of the body or headers, this is the
# place to do it.
# Uncomment the next line when debugging the message reading/generating
#DEBUG
# Now post the message. Simple, isn't it?
connect $host $port
# You might need to add some stuff here for authentication on some servers.
post
quit
# That's all, folks!
exit 0
