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 Fellows]''

PS: 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