#!/usr/bin/env tclsh
## -*- tcl -*-
package require Tcl 8.5
package require nntp
package require fileutil
# This application, derived from its sibling 'postnews', takes a
# message file and directly posts it to a given server, and group. All
# other information, like destination group, subject, sender, etc. are
# expected to be in the message itself. This means that the message
# file is expected to have the proper format for a mail/news posting.
#
# Using "-" for the message file causes the command to read the
# message from stdin.
proc main {} {
if {![cmdline]} usage
checkmessage
postmessage
}
proc cmdline {} {
global argv newsserver message user password
if {[lindex $argv 0] eq "-via"} {
if {[llength $argv] != 4} {return 0}
set argv [lassign $argv _ accountfile]
lassign [split [validatefile {account file} $accountfile] \n] user password
}
if {[llength $argv] != 2} {return 0}
# Retrieve arguments
lassign $argv newsserver messagefile
# Validate messagefile
if {$messagefile eq "-"} {
set message [read stdin]
} else {
set message [validatefile {message file} $messagefile]
}
return 1
}
proc validatefile {which path} {
if {![file exists $path]} { stop "$which does not exist: $path" }
if {![file isfile $path]} { stop "$which not a file: $path" }
if {![file readable $path]} { stop "$which not readable: $path" }
return [fileutil::cat $path]
}
proc usage {} {
global argv0
puts stderr "$argv0: wrong # args, should be \"$argv0 ?-via accountfile? server messagefile\""
exit 1
}
proc stop {text} {
global argv0
puts stderr "$argv0: $text"
exit 1
}
proc checkmessage {} {
processmessage
need Newsgroups
need Subject
need From
add "X-Posting-Engine" "Tcllib nntp/postmsg on Tcl [info patchlevel]"
# Some news-servers handle the adding of the Lines: header itself
#add Lines [llength $body]
add "Content-Type" "text/plain; charset=iso-8859-1"
regenerate
return
}
proc processmessage {} {
global message head body
array set head {}
set body {}
set inBody 0
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] "
}
}
return
}
proc need {header} {
global head
if {[info exist head([string tolower $header])]} return
stop "Required header \"${header}:\" is missing"
}
# Add the given header to the message to be posted, if not already present.
proc add {header value} {
global head
set header [string tolower $header]
if {[info exist head($header)]} return
set head($header) $value
return
}
proc regenerate {} {
global message head body
foreach {header value} [array get head] {
lappend lines "[capitalise $header]: [string trim $value]"
}
lappend lines {}
lappend lines $body
set message [join $lines \n]
return
}
proc capitalise {string} {
set result {}
foreach word [split $string "-"] {lappend result [capitalise1 $word]}
join $result "-"
}
proc capitalise1 {word} {
set c0 [string index $word 0]
set cr [string range $word 1 end]
return [string toupper $c0][string tolower $cr]
}
proc postmessage {} {
global newsserver message user password
nntp_cmd 1 {open } {set news [nntp::nntp $newsserver]}
nntp_cmd 1 {mode reader} {$news mode_reader}
if {[info exists user]} {
nntp_cmd 1 {authinfo } {$news authinfo $user $password}
}
puts stdout "post [llength [split $message \n]] lines"
nntp_cmd 0 {post } {$news post $message}
nntp_cmd 1 {quit } {$news quit}
return
}
proc nntp_cmd {exit title cmd {oktitle {}}} {
global argv0
puts -nonewline stdout $title
flush stdout
if {[catch {
set res [uplevel 1 $cmd]
} msg]} {
puts stdout " error: $msg"
#puts stderr "$argv0: nntp error: $msg"
if {$exit} {
exit 1
}
return 0
} else {
if {$oktitle != {}} {
puts stdout " $res $oktitle"
} else {
puts stdout " $res"
}
return 1
}
}
main
exit
