#!/bin/sh
# -*- Mode: Tcl -*-
#
# Name		brag
# Description	Grab and assemble multipart binary attachements from 
#		news server
# Copyright	(c) 2000-2003 by Akos Polster. See the file LICENSE for 
#		information on licensing
# Version	$Id: brag,v 1.41 2003/11/12 12:04:32 akos Exp $
#
# \
exec tclsh "$0" ${1+"$@"}

# We have a single global array "state" which tracks all the information
# about all of our transfers in progress.  The keys of the array are the
# concatenation of the strings
# thread_number "," value
# Where value is one of the following criteria
#   socket: the channel_id to the server.  This never gets reset.
#   subject: the subject of the article used for naming
#   textSubject: the original fullsubject of the article
#   article: the article number.  If this is unset, the connection is unused.
#   part: the part number
#   totalParts: the total number of parts for the binary
#   tmpFile: the file containing our body lines.  A channel_id.
#   partName: The final filename for the part.
#   tmpName: The name for incremental saves of the part as we read it.
#   dir: the directory for our parts
#   response: the last response code received
#   size: bytes for this part
#   time: time this part started being received

# Check Tcl version
if {[info tclversion] < 8.0} {
    puts stderr "brag: Your Tcl is too old. Brag needs Tcl 8.0 or later"
    exit 1
}

###############################################################################
# This is a subset of Neil D. McKay's NNTP extension. The full package is 
# available at http://www.neosoft.com/tcl/ftparchive/sorted/net/NNTP/0.01/

namespace eval NNTP {

    variable groups	;# If we're asked for a group list, this holds it
    variable slowDown 0	;# Number of milliseconds to sleep between retrieving
			;# lines from server

    # "ResponseCode" extracts the numeric response code from
    # an NNTP reponse message.

    proc ResponseCode {msg} {
	return [lindex [split [string trimleft $msg] " "] 0]
    }

    # "Open" tries to open a news connection to host "host".
    # If it succeeds, it returns an "nntp connection handle",
    # which is a unique ID associated with the connection.
    # If it fails, it returns an error message, and returns an
    # error code of 1.
    #
    # Allowed options are:
    #
    #	-port <portNo>		TCP port to connect to; defaults to 119
    #
    #   -user <name>      	User name. If specified, NNTP authentication
    #				is performed after connecting to the server
    #
    #   -password <pass>	Password. Defaults to ""
    #

    proc Open {host args} {

	# Set defaults for optional arguments, and parse the options.

	set opts(-port) 119
        set opts(-user) ""
        set opts(-password) ""

	array set opts $args

	# Try to open the NNTP connection.

	set ecode [catch [list socket $host $opts(-port)] sock]

	if {$ecode != 0} {
	    return -code error "Couldn't make news connection: $sock"
	}

	# Configure the socket so that it trims off the trailing CRLF.

	fconfigure $sock -encoding binary
	fconfigure $sock -translation crlf
	fconfigure $sock -buffering line

	# Get the server's response string.

	set response ""
	set nChars [gets $sock response]

	if {$nChars < 0} {
	    catch [list close $sock]
	    return -code error "End-of-file on socket"
	}

	# Authenticate if requested

        if {[string compare $opts(-user) ""]} {
	    puts $sock "AUTHINFO USER $opts(-user)"
	    flush $sock
	    set nchars [gets $sock response]
	    if {$nchars < 0} {
	        catch [list Close $nntpHandle]
	        return -code error "Server disconnected prematurely"
	    }
	    puts $sock "AUTHINFO PASS $opts(-password)"
	    flush $sock
	    set nchars [gets $sock response]
	    if {$nchars < 0} {
	        catch [list Close $nntpHandle]
	        return -code error "Server disconnected prematurely"
	    }
	    set msgCode [ResponseCode $response]
	    if {$msgCode != 281} {
	        return -code error "Authentication failed: $response"
	    }
        }

	# Send MODE READER.
	puts $sock "MODE READER"
	flush $sock
	set nchars [gets $sock response]
	if {$nchars <= 0} {
	    catch [list Close $nntpHandle]
	    return -code error "Server disconnected prematurely"
	}
	set msgCode [ResponseCode $response]
	if {$msgCode != 200 && $msgCode != 201} {
	    return -code error "MODE READER failed: $response"
	}

	# Return the connection handle.
	return $sock
    }

    # "Close" closes the connection associated with "nntpHandle",
    # and does all necessary cleanup.

    proc Close {nntpHandle} {
	global state

	# Try to send a QUIT command; then close the socket, and clean up.

	set sock $state($nntpHandle,socket)
	puts $sock "QUIT"
	flush $sock
	close $sock
	unset state($nntpHandle,socket))
    }

    # "SetGroup" sets the newsgroup for the server associated with
    # "nntpHandle" to "groupName". If successful, it returns a
    # list containing three elements: the newsgroup name, the
    # number of the first available article in the newsgroup, and
    # the number of the last available article.

    proc SetGroup {nntpHandle groupName} {
	global state

	set sock $state($nntpHandle,socket)

	# Send the "GROUP" command, and get a response.

	puts $sock "GROUP $groupName"
	flush $sock
	set nchars [gets $sock response]
	if {$nchars < 0} {
	    catch [list Close $nntpHandle]
	    return -code error "Server disconnected prematurely"
	}

	# Check for errors...

	set msgCode [ResponseCode $response]
	if {$msgCode != 211} {
	    return -code error "Error setting newsgroup: $response"
	}

	# We're OK: return the info.

	set groupName [lindex $response 4]
	set firstArticleNo [lindex $response 2]
	set lastArticleNo [lindex $response 3]
	return [list $groupName $firstArticleNo $lastArticleNo]
    }

    # "GetGroups" returns the list of newsgroups available on the server.
    # A list item is a triplet containing the group name, first article 
    # index and last article index.

    proc GetGroups {nntpHandle} {
	global state
	variable slowDown

	set ret {}
	set sock $state($nntpHandle,socket)

	puts $sock "LIST"
	flush $sock
	set nchars [gets $sock response]
	if {$nchars < 0} {
	    catch [list Close $nntpHandle]
	    return -code error "Server disconnected prematurely"
	}

	# Check for errors...

	set msgCode [ResponseCode $response]
	if {$msgCode != 215} {
	    return -code error "Error reading groups: $response"
	}

	while {1} {
	    if {$slowDown} {
		after $slowDown
	    }

	    # Get a line of text; we're done if it consists of a single ".".

	    set nchars [gets $sock line]
	    if {$nchars < 0} {
		catch [list Close $nntpHandle]
		return -code error "Server disconnected prematurely"
	    }

	    if {[string compare $line "."] == 0} {
		break
	    }

	    set fields [split $line " "]
	    set name [lindex $fields 0]
	    set last [lindex $fields 1]
	    scan $last %d last
	    set first [lindex $fields 2]
	    scan $first %d first
	    lappend ret [list $name $first $last]
	}

	return $ret
    }

    # "GetSubjects" retrieves the subjects of the articles in the range
    # indicated

    proc GetSubjects {nntpHandle first last subjectarrayname} {
	global state
	variable slowDown

	upvar $subjectarrayname subjects

	set sock $state($nntpHandle,socket)

	# Send the "XHDR" command, and get a response.

	puts $sock "XHDR Subject $first-$last"
	flush $sock
	set nchars [gets $sock response]
	if {$nchars <= 0} {
	    catch [list Close $nntpHandle]
	    return -code error "Server disconnected prematurely"
	}

	# Check for errors...

	set msgCode [ResponseCode $response]
	if {$msgCode != 221} {
	    return -code error "Error reading article subjects: $response"
	}

	set text ""
	while {1} {
	    if {$slowDown} {
		after $slowDown
	    }

	    # Get a line of text; we're done if it consists of a single ".".

	    set nchars [gets $sock line]
	    if {$nchars < 0} {
		catch [list Close $nntpHandle]
		return -code error "Server disconnected prematurely"
	    }

	    if {[string compare $line "."] == 0} {
		return
	    }

	    regexp -nocase {([0-9]+) +(.+)} $line dontcare artno subj
	    # is this tcl idiom for making it numeric?
	    set artno [expr {$artno + 0}]
	    set subjects($artno) $subj
	    # puts stderr "$artno--> $subj"
	}
	return
    }
}

###############################################################################
# Namespace variables

namespace eval brag {
    variable server			;# News server
    variable port 119                   ;# TCP port
    variable group 			;# Newsgroup
    variable defaultServer "news"	;# Default news server
    variable defaultGroup "alt.binaries.pictures.cemetaries"
					;# Default newsgroup
    variable finished			;# Directory for finished files
    variable unfinished			;# Directory for work files
    variable oldSubjects		;# Directory names by subject
    variable accept {}			;# List of accepted subjects
    variable reject {}			;# List of rejected subjects
    variable first			;# First message on server
    variable last			;# Last message on server
    variable total			;# Total number of unread messages
    variable handle			;# NNTP connection handle
    variable verbose 1			;# Be verbose
    variable saveSubjects 0		;# Don't save message subjects
    variable user			;# User name
    variable password			;# Password
    variable combine 0                  ;# Don't combine parts from
                                        ;# different newsgroups
    variable combineServers 0		;# Don't combine parts from different
					;# servers
    variable getSingle 0		;# If true, get single-part msgs, too
    variable finishedThread 1           ;# Flag to signify that a thread is
                                        ;# ready for another task
    variable threads 2                  ;# The number of connections to open
    variable slowDown 0			;# Milliseconds to sleep between 
					;# retrieving lines from server
}

###############################################################################
# Get old directory/subject pairs

proc brag::getOldSubjects {} {

    variable oldSubjects
    variable unfinished

    print "Scanning"

    foreach sub [glob -nocomplain -- [file join $unfinished "*"]] {
	if {[file exists [file join $sub "subject"]]} {
	    if {[catch {
		set fh [open [file join $sub "subject"]]
		set subject [read -nonewline $fh]
		close $fh
	    } err]} {
		puts stderr "brag: Cannot load subject file: $err"
		exit 3
	    }
	    set oldSubjects($subject) $sub
	}
    }
}

###############################################################################
# Get directory name based on message subject. If the directory doesn't exist,
# create and initialize it

proc brag::getDirBySubject {subject totalParts} {

    variable oldSubjects
    variable unfinished

    if {![info exists oldSubjects($subject)]} {
	for {set dirName [clock seconds]} \
            {[file exists [file join $unfinished $dirName]]} \
            {incr dirName} {
	}
	set oldSubjects($subject) [file join $unfinished $dirName]
	if {[catch {
	    file mkdir $oldSubjects($subject)
	    set fh [open [file join $oldSubjects($subject) "subject"] "w"]
	    puts $fh $subject
	    close $fh
	} err]} {
	    puts stderr "brag: Cannot create subject file: $err"
	    exit 3
	}
    }
    return $oldSubjects($subject)
}

###############################################################################
# Get server directory name based on server name

proc brag::getServerDir {} {
    variable server
    return [file join "~" ".brag" $server]
}

###############################################################################
# Get group directory name based on server/group

proc brag::getGroupDir {} {
    return [file join [getServerDir] [getGroupBaseDir]]
}

###############################################################################
# Get group base directory

proc brag::getGroupBaseDir {} {
    variable group
    regsub -all -- {[^a-zA-Z0-9_.]} $group "_" dir
    return $dir
}

###############################################################################
# Initialize variables, create work directories, open connection

proc brag::init {argList} {

    global env
    global state

    variable server
    variable port
    variable group
    variable defaultServer
    variable defaultGroup
    variable finished
    variable unfinished
    variable accept
    variable reject
    variable first
    variable last
    variable handle
    variable verbose
    variable saveSubjects
    variable user
    variable password
    variable combine
    variable combineServers
    variable total
    variable max
    variable getSingle
    variable threads
    variable slowDown

    # Process command line

    for {set i 0} {$i < [llength $argList]} {incr i} {
	switch -exact -- [lindex $argList $i] {
	    "-L" {
		set lflag 1
	    }
	    "-s" {
		incr i
		set server [lindex $argList $i]
	    }
            "-P" {
                incr i
                set port [lindex $argList $i]
            }
	    "-g" {
		incr i
		set group [lindex $argList $i]
	    }
	    "-q" {
		set verbose 0
	    }
	    "-v" {
		set verbose 1
		puts stderr "brag: Warning: Option -v is deprecated"
	    }
	    "-u" {
		set saveSubjects 1
	    }
	    "-o" {
		incr i
		set finished [lindex $argList $i]
	    }
	    "-a" {
		incr i
		lappend accept [string tolower [lindex $argList $i]]
	    }
	    "-r" {
		incr i
		lappend reject [lindex $argList $i]
	    }
            "-n" {
                incr i
                set lastSaved [lindex $argList $i]
            }
            "-l" {
                incr i
                set user [lindex $argList $i]
            }
            "-p" {
                incr i
                set password [lindex $argList $i]
            }
            "-c" {
                set combine 1
            }
	    "-C" {
		set combineServers 1
	    }
	    "-A" {
		incr i
		loadAcceptFile [lindex $argList $i]
	    }
	    "-R" {
		incr i
		loadRejectFile [lindex $argList $i]
	    }
	    "-X" {
		set getSingle 1
	    }
	    "-t" {
		incr i
		set threads [lindex $argList $i]
	    }
	    "-b" {
		incr i
		set slowDown [lindex $argList $i]
		set NNTP::slowDown $i
	    }
	    "-m" {
		incr i
		set max [lindex $argList $i]
	    }
 	    default {
		usage
	    }
	}
    }

    # Set news server if not present on command line
    if {![info exists server]} {
	if {[info exists env(NNTPSERVER)]} {
	    set server $env(NNTPSERVER)
	} else {
	    set server $defaultServer
	    puts stderr \
		"brag: Warning: Using default server \"$defaultServer\""
	}
    }
    set serverDir [getServerDir]

    # Get password from passwd file, if not specified on the command line

    if {[info exists user]} {
        if {![info exists password]} {
            catch {
                set fh [open [file join [getServerDir] "passwd"]]
		foreach line [split [read $fh] "\n"] {
                    if {[string match "${user}:*" $line]} {
                        regsub -- "^${user}:" $line "" password
                        break
                    }
                }
                close $fh
            }
            if {![info exists password]} {
                puts stderr "brag: No password for user \"$user\""
                exit 1
            }
        }
    }

    if {![info exists lflag]} {
	# Set the group if not present on the command line.
	if {![info exists group]} {
	    if {[info exists env(NNTPGROUP)]} {
		set group $env(NNTPGROUP)
	    } else {
		set group $defaultGroup
		puts stderr \
		     "brag: Warning: Using default newsgroup \"$defaultGroup\""
	    }
	}
	set groupDir [getGroupDir]

	# Create work directories

	if {$combineServers} {
	    set workBase [file join "~" ".brag" "all-servers"]
	} else {
	    set workBase [getServerDir]
	}

	if {![info exists finished]} {
	    if {$combine} {
		set finished [file join $workBase "finished"]
	    } else {
		set finished [file join $workBase [getGroupBaseDir] "finished"]
	    }
	}
	if {$combine} {
	    set unfinished [file join $workBase "unfinished"]
	} else {
	    set unfinished [file join $workBase [getGroupBaseDir] "unfinished"]
	}

	if {[catch {
	    file mkdir $groupDir
	    file mkdir $finished
	    file mkdir $unfinished
	} err]} {
	    puts stderr "brag: Cannot create work directory: $err"
	    exit 3
	}
    
	# Read in old subjects.  This can take a LOOOOOONG time!
	getOldSubjects

	# Load per-group accept/reject files
	loadAcceptFile [file join $groupDir "accept"]
	loadRejectFile [file join $groupDir "reject"]

	if {![llength $accept]} {
	    set accept {*}
	}

	# Get index of last retreived message

	if {![info exists lastSaved]} {
	    if {[catch {
		set fh [open [file join $groupDir "last"]]
		set lastSaved [read -nonewline $fh]
		close $fh
		incr lastSaved
	    } err]} {
		set lastSaved 0
	    }
	}
    }

    # Open first connection to the news server--we'll use this to get
    # the subjects or group list.
    # We don't open all of the connections here because it may take a LOOOONG
    # time to fetch all the subjects, and the server might timeout the idle
    # connections.

    for {set i 0} {$i < 1} {incr i} {
	if {[catch {
	    if {[info exists user]} {
		set state($i,socket) [NNTP::Open $server -port $port \
		-user $user -password $password]
	    } else {
		set state($i,socket) [NNTP::Open $server -port $port]
	    }
	    } err]} {
		puts stderr "brag: $err"
		exit 2
	}
    }

    # If we want the group list, handle that here.
    if {[info exists lflag]} {
	foreach triplet [NNTP::GetGroups 0] {
	    set total [expr {[lindex $triplet 2] - [lindex $triplet 1] + 1}]
	    if {$total > 1} {
	        puts "[lindex $triplet 0] - $total articles"
	    } else {
		puts "[lindex $triplet 0] - $total article"
            }
        }
	exit 0
    }

    set trio [NNTP::SetGroup 0 $group]

    set first [lindex $trio 1]
    set last [lindex $trio 2]
    if {$lastSaved > $first} {
	set first $lastSaved
    }


    print "Server: $server"
    print "Group: $group"
    print "Finished: $finished"
    print "Unfinished: $unfinished"
    print "Accept: [list $accept]"
    print "Reject: [list $reject]"
    print "First: $first"
    print "Last: $last"
    if {[info exists max] && (($last - $first) > $max)} {
	set last [expr {$first + $max - 1}]
    }
    set total [expr {$last - $first + 1}]

    if {$first > $last} {
	exit 0
    }

    # Now, if there are fewer articles than threads requested, adjust the
    # number of threads so we don't open more than we need.
    if {$total < $threads} {
	set threads $total
    }

}

###############################################################################
# Print thread statistics

proc brag::printFinished {handle} {
    global state

    # Compute elapsed time
    set totaltime [expr [clock seconds] - $state($handle,time)]
    if {$totaltime < 1} {
	set totaltime 1
    }

    # Now, re-express the size in KB
    set state($handle,size) [expr $state($handle,size) / 1024]

    # And finally, what we came here for
    print "  Connection $handle finished: $state($handle,size)KB in ${totaltime} seconds ([expr $state($handle,size) / $totaltime]KB/s)"
}

###############################################################################
# Quit thread

proc brag::quitThread {handle msg {printFinished 1}} {

    global state
    variable finishedThread

    if {[info exists state($handle,tmpFile)]} {
	close $state($handle,tmpFile)
	if {[file exists $state($handle,tmpName)]} {
	    file delete -- $state($handle,tmpName)
	}
    }

    # Note the article number
    set artnum $state($handle,article)

    if {$printFinished} {
	printFinished $handle
    }

    # Clear out everything but the socket.
    set handlearray [array get state "$handle,*"]
    set handlearraylen [llength $handlearray]
    for {set i 0} {$i < $handlearraylen} {incr i 2} {
	set key [lindex $handlearray $i]
	if {[string compare $key "$handle,socket"]} {
	    unset state($key)
	}
    }

    # And then notify any interested parties that this thread is complete.
    fileevent $state($handle,socket) readable ""
    set finishedThread 1

    if {[string compare $msg ""]} {
	return -code error $msg
    } else {
	# On success, we update the saved last processed article number
	set artarray [array get state "*,article"]
	set artarraylen [llength $artarray]
	for {set i 1} {$i < $artarraylen} {incr i 2} {
	    set article [lindex $artarray $i]
	    if {$article < $artnum} {
		set found 1
		break
	    }
	}
	if {![info exists found]} {
	    # We are the lowest id--update.
	    saveCounter $artnum 1
	}
    }
}

###############################################################################
# Get a line of text

proc brag::getLine {handle} {

    global state
    variable slowDown

    if {$slowDown} {
	after $slowDown
    }

    set nchars [gets $state($handle,socket) buf]
    if {$nchars < 0} {
	if {[fblocked $state($handle,socket)]} {
	    return
	} else {
	    catch [list Close $handle]
	    quitThread $handle "Server disconnected prematurely"
	}
    }

    incr state($handle,size) $nchars

    # We're done if it consists of a single ".".

    if {[string compare $buf "."] == 0} {
	if {[catch {
	    close $state($handle,tmpFile)
	    unset state($handle,tmpFile)
	    # Don't try to rename it if it got deleted by a decode.  This should
	    # only happen if we're downloading a part which isn't needed
	    # for the decode, such as a part which we already have or part 0.
	    if {[file exists $state($handle,tmpName)]} {
		file rename -force -- $state($handle,tmpName) \
		                      $state($handle,partName)
	    }
	} err]} {
	    puts stderr "brag: Cannot save message body: $err"
	    catch {file delete --force -- $state($handle,partName)}
	    catch {file delete --force -- $state($handle,tmpName)}
	    exit 3
	}

	printFinished $handle

	# Attempt to assemble parts
	assembleParts $handle

	# Clean up the thread, but DON'T print the finished message
	quitThread $handle "" 0
    } else {
        # If the first char is a ".", then trim it off, since
        # an initial "." will be doubled.

        set firstChar [string index $buf 0]
        if {[string compare $firstChar "."] == 0} {
	    set buf [string range $buf 1 end]
        }

        # Add the line...
	if {[catch {
	    puts $state($handle,tmpFile) $buf
	} err]} {
	    quitThread $handle "brag: Cannot save message body: $err"
	    exit 3
	}
    }
}

###############################################################################
# Queue thread

proc brag::queueThread {handle} {
    global state

    if {[file exists $state($handle,partName)]} {
	print "  Already received part"
	quitThread $handle ""
	return
    }

    # Is there already a thread reading this item?
    # We look at directory and part numbers.
    set a [array get state "*,article"]
    set alen [llength $a]
    for {set i 0} {$i < $alen} {incr i 2} {
	set thread [lindex [split [lindex $a $i] ","] 0]
	if {$thread == $handle} {
	    continue
	}
	if {[string compare $state($thread,dir) $state($handle,dir)] == 0 && \
	    [string compare $state($thread,part) $state($handle,part)] == 0} {
	    print "  Already received part"
	    quitThread $handle ""
	    return
	}
    }

    # Send the "BODY" command, and get a response.
    set nchars 0
    set response ""
    catch {
        fconfigure $state($handle,socket) -blocking 1
        puts $state($handle,socket) "BODY $state($handle,article)"
        flush $state($handle,socket)
        set nchars [gets $state($handle,socket) response]
    }
    if {$nchars < 0} {
	puts stderr "brag: Server disconnected prematurely"
        exit 2
    }

    # Check for errors...
    set msgCode [NNTP::ResponseCode $response]
    if {$msgCode != 222} {
	switch -- $msgCode {
	    423 - 430 {
		print "  Expired"
	        quitThread $handle ""
	        return
	    }
	    default {
		puts stderr "brag: Error reading article text: $response"
		exit 2
	    }
	}
    }

    set state($handle,tmpFile) [open $state($handle,tmpName) "w"]
    fconfigure $state($handle,tmpFile) -encoding binary
    puts $state($handle,tmpFile) "Subject: $state($handle,textSubject)\n"
    print "  Connection $handle: Fetching \"$state($handle,textSubject)\""
    fileevent $state($handle,socket) readable [list brag::getLine $handle]
    fconfigure $state($handle,socket) -blocking 0
}

###############################################################################
# Get and store partial postings

proc brag::getParts {} {

    global state
    variable finishedThread

    variable server
    variable port
    variable group
    variable user
    variable password
    variable unfinished
    variable accept
    variable reject
    variable first
    variable last
    variable total
    variable getSingle
    variable handle
    variable threads

    set prevCnt -1

    # Get subjects

    print "Getting subjects $first-$last"
    getSubjects 0 $first $last subjects

    # Now, open the rest of the threads requested.
    for {set i 1} {$i < $threads} {incr i} {
	puts stdout "Opening additional connection $i"
	if {[catch {
	    if {[info exists user]} {
		set state($i,socket) [NNTP::Open $server -port $port \
		-user $user -password $password]
	    } else {
		set state($i,socket) [NNTP::Open $server -port $port]
	    }
	    set trio [NNTP::SetGroup $i $group]
	    } err]} {
		puts stderr "brag: $err"
		exit 2
	}
    }

    # Get news
    
    for {set cnt $first} {$cnt <= $last} {incr cnt} {

	set now [expr {$cnt - $first + 1}]
	set percent [expr {($now * 100) / $total}]
	print "Message: $cnt ($now of $total, ${percent}%)"

	# Get subject
	if [catch {set subject $subjects($cnt)}] {
	    print "  Expired: Not in xhdr"
	    saveCounter $cnt
	    continue
	}
	print "  Subject: $subject"

	# Get current part number and the total. Reject plain/single-part 
	# messages

	set fullSubject $subject
	set match [getLastMatch $subject {([0-9]+/[0-9]+)}]
	set matchBegin [lindex $match 0]
	set matchEnd [lindex $match 1]
	set matchString [lindex $match 2]
	if {$matchBegin != -1} {
	    set p [split $matchString "/"]
	    set current [lindex $p 0]
	    set totalParts [lindex $p 1]
	    # Part numbers might contain leading zeros - remove them
	    regsub {^0+} $current "" current
	    regsub {^0+} $totalParts "" totalParts
	    set newSub [string range $subject 0 [expr {$matchBegin - 1}]]
	    append newSub [string range $subject [expr {$matchEnd + 1}] end]
	    set subject $newSub
	} else {
	    print "  Plain"
	    if {$getSingle} {
		set current 1
		set totalParts 1
	    } else {
		saveCounter $cnt
		continue
	    }
	}

	# If subject matches one of the patterns in the reject file, 
	# reject message

	set accepted 1
	foreach pattern $reject {
	    if {[string match $pattern [string tolower $subject]]} {
		print "  Rejected: $pattern"
		set accepted 0
		break
	    }
	}
	if {!$accepted} {
	    saveCounter $cnt
	    continue
	}

	# If subject matches one of the patterns in the accept file, 
	# accept message, otherwise reject it

	set accepted 0
	foreach pattern $accept {
	    if {[string match $pattern [string tolower $subject]]} {
		print "  Accepted: $pattern"
		set accepted 1
		break
	    }
	}
	if {!$accepted} {
	    print "  Rejected"
	    saveCounter $cnt
	    continue
	}

	# Assembled already?

	set dir [getDirBySubject $subject $totalParts]
	# print "  Dir: [file tail $dir]"
	if {[file exists [file join $dir "finished"]]} {
	    print "  Old: Assembled already"
	    saveCounter $cnt
	    continue
	}

	# If all the threads are currently in-use, wait here for one to become
	# available.
	set nthreads [llength [array get state "*,socket"]]
	if {$nthreads == [llength [array get state "*,article"]]} {
	    print "  Waiting for free connection"
	    vwait brag::finishedThread
	}

	# Now, find an available thread.
	set nthreads [expr $nthreads / 2]
	for {set i 0} {$i < $nthreads} {incr i} {
	    if {! [info exists state($i,article)]} {
		break
	    }
	}
	if {$i >= $nthreads} {
	    return -code error "WTF?  No thread available!"
	}

	# Store everything in the state.  The only thing remaining unset is
	# the tmpFile channel, and this waits until we've tested if we've
	# already got/are getting the article.
	set state($i,textSubject) $fullSubject
	set state($i,subject) $subject
	set state($i,article) $cnt
	set state($i,part) $current
	set state($i,dir) $dir
	set state($i,totalParts) $totalParts
	set state($i,response) 0
	set state($i,partName) [file join $state($i,dir) "part.$state($i,part)"]
	set state($i,tmpName) "$state($i,partName).tmp"
	set state($i,size) 0
	set state($i,time) [clock seconds]

	# Add the handler to this socket
	queueThread $i

	# Look for another interesting article
    }

    print "  Waiting for connections to complete"

    # Wait for all threads to complete.
    while {[llength [array get state "*,article"]] != 0} {
	vwait brag::finishedThread
    }

    saveCounter $last 1
}

###############################################################################
# Assemble parts

proc brag::assembleParts {handle} {
    global state

    variable unfinished
    variable finished
    variable saveSubjects

    set dir $state($handle,dir)
    set totalParts $state($handle,totalParts)
    set subject $state($handle,subject)

    # Skip finished files
    
    if {[file exists [file join $dir "finished"]]} {
	print "  Old"
	return
    }
	
    # Verify that all parts are available
	
    if {[catch {format "%d" $totalParts}] || ($totalParts < 1)} {
	puts stderr \
	    "brag: Total number of parts is \"$totalParts\", should be >= 1"
        puts stderr "      Check part files in $dir"
	return
    }
    # When computing how many parts we currently have, don't include the
    # ones which are "in-process" (end in .tmp).  Since Tcl uses crappy
    # csh-style globbing, we just subtract out the temps from the number
    # of all parts.
    if {[expr [llength [glob -nocomplain [file join $dir "part.*"]]] - [llength [glob -nocomplain [file join $dir "part.*.tmp"]]]] < $totalParts} {
	print "  Incomplete: Not enough parts"
	return
    }
	
    set complete 1
    set partList {}
    for {set i 1} {$i <= $totalParts} {incr i} {
	if {[file exists [file join $dir "part.$i"]]} {
	    lappend partList "part.$i"
	} elseif {[file exists [file join $dir "part.0$i"]]} {
	    lappend partList "part.0$i"
	} elseif {[file exists [file join $dir "part.00$i"]]} {
	    lappend partList "part.00$i"
	} elseif {[file exists [file join $dir "part.000$i"]]} {
	    lappend partList "part.000$i"
	} else {
	    set complete 0
	    break
	}
    }
	
    if {!$complete} {
	print "  Incomplete: Part $i is missing"
	return
    }
    
    # Decode parts
    
    print "  Complete"

    cd "$dir"
    if {[catch {decode $subject $partList} err]} {
	set decoded 0
	puts stderr "brag: Failed to decode parts in $dir: $err"
    } else {
	set decoded 1
    }
    
    # Save decoded files; clean up others
    
    foreach file [glob -nocomplain -- *] {
	switch -glob -- ./$file {
	    "./part." - "./subject" {
            }
	    "./part.*" {
		if {$decoded} {
		    catch {file delete -force -- ./$file}
		}
	    }
	    default {
		set dst [getDestination $file $finished $subject]
		if {[catch {
		    file rename -force -- ./$file $dst
		} err]} {
		    puts stderr "brag: Cannot save decoded file: $err"
		} else {
		    print "  Assembled: [file tail $dst]"
		    catch {
			set fh [open "finished" "w"]
			close $fh
		    }
		}
		catch {file delete -force -- ./$file}
		if {$saveSubjects} {
		    catch {file copy -force -- "subject" "$dst.sub"}
		}
	    }
	}
    }
}

###############################################################################
# Concatenate and decode parts

proc brag::decode {subject partList} {
    eval exec uudeview -i -a -m -d -s -s -q $partList
}

###############################################################################
# Get destination file name

proc brag::getDestination {file dir subject} {

    # The message subject might be well formatted, so we gan get a good file 
    # name from it. Otherwise use the original file name

    regsub -all -- { - } $subject "|" subject
    regsub -all -- {y[eE]nc} $subject "" subject
    set fields [split $subject "|"]
    if {[llength $fields] > 1} {
	set base [lindex $fields end]
	if {[regexp {[0-9,]+ bytes} $base] || [regexp {[0-9,]+[KM]} $base]} {
	    set base [lindex $fields [expr {[llength $fields] - 2}]]
	}
	regsub "\\(\\)|\\\[\\\]" $base "" base
	set base [file tail [string trim [string trim $base {~}]]]
    } else {
	set base [file tail [string trim $file {~}]]
    }
    regsub -all -- { [0-9,]+ bytes} $base {} base
    regsub -all -- { [0-9,]+[KM]B*} $base {} base
    set base [string trim $base {"}]
    regsub -all -- {[^a-zA-Z0-9_. ]} $base "_" base

    # If the file doesn't already exist in the destination directory, 
    # return it, otherwise create a unique name based on the original

    if {![file exists [file join $dir $base]]} {
        return [file join $dir $base]
    } else {
        set ext [file extension $base]
        set root [file rootname $base]
        for {set i 1} {[file exists [file join $dir "$root$i$ext"]]} {incr i} {
        }
        return [file join $dir "$root$i$ext"]
    }
}

###############################################################################
# Print usage message and exit

proc brag::usage {} {
    puts stderr "brag - Grab multipart binaries from news server

Usage: brag \[-s server\] \[-P port\] \[-g group\] \[-l user\] \[-p pass\]
            \[-o dir\] \[-n n\] \[-q\] \[-u\] \[-c\] \[-C\] \[-X\]
            \[-a pattern \[-a pattern\] ...\] \[-r pattern \[-r pattern\] ...\]
            \[-A file\] \[-R file\] \[-t number\] \[ -m max \]
or
       brag -L \[-s server\] \[-P port\] \[-l user\] \[-p pass\]

  -L                    Just dump a listing of available newsgroups and exit
  -s server             Set news server to server
  -P port               Use port when connecting to news server
  -g group              Set newsgroup to group
  -o dir                Set output directory to dir
  -l user               Set user name to user
  -p pass               Set password to pass
  -n n                  Start from article number n
  -q                    Be quiet: do not display progress messages
  -u                    Save message subjects, too
  -c                    Combine parts even if they are from different groups
  -C                    Combine parts even if they are from different servers
  -X                    Process single-part messages, too
  -a pattern            Accept messages matching the pattern
  -r pattern            Reject messages matching the pattern
  -A file               Read accept patterns from file
  -R file               Read reject patterns from file
  -t n                  Use n number of connections (default 2)
  -m max                Set the maximum number of messages to download"

    exit 1
}

###############################################################################
# Save messag counter

proc brag::saveCounter {cnt {force 0}} {

    if {$force || (0 == ($cnt % 5))} {
        set tmpFile [file join [getGroupDir] "last.tmp"]
        set cntFile [file join [getGroupDir] "last"]
        if {[catch {
            set fh [open $tmpFile "w"]
            puts $fh $cnt
            close $fh
            file rename -force -- $tmpFile $cntFile
        } err]} {
            puts stderr "brag: Cannot save message counter: $err"
            exit 3
        }
    }
}

###############################################################################
# Print message if in verbose mode

proc brag::print {msg} {
    variable verbose
    if {$verbose} {
	puts $msg
    }
}

###############################################################################
# Find the last match of a regular expression
# Returns	A list of three elements: the indices of the first and last 
#		characters in the matching range of characters, plus the
#		matching range itself. In case of no match, the indices are
#		set to -1, while the range is set to ""

proc brag::getLastMatch {str pattern} {

    set source $str
    set offset 0
    set matchFirst -1
    set matchLast -1
    set matchString ""

    while {[regexp -indices -- $pattern $source match]} {
	set first [lindex $match 0]
	set last [lindex $match 1]
	set next [expr {$last + 1}]
	set matchFirst [expr {$first + $offset}]
	set matchLast [expr {$last + $offset}]
	set matchString [string range $str $matchFirst $matchLast]
	set source [string range $source $next end]
	if {[string compare "" $source]} {
	    incr offset $next
	} else {
	    break
	}
    }

    return [list $matchFirst $matchLast $matchString]
}

###############################################################################
# Load accept patterns from a file

proc brag::loadAcceptFile {acceptFile} {

    variable accept

    if {[file exists $acceptFile]} {
	if {[catch {
	    set fh [open $acceptFile]
	    foreach line [split [read $fh] "\n"] {
		set l [string trim $line]
		switch -glob -- $l {
		    "" - "\#*" {
		    }
		    default {
			lappend accept [string tolower "${l}"]
		    }
		}
	    }
	    close $fh
	} err]} {
	    puts stderr "brag: Cannot process accept file: $err"
	    exit 3
	}
    }
}

###############################################################################
# Load reject patterns from a file

proc brag::loadRejectFile {rejectFile} {

    variable reject

    if {[file exists $rejectFile]} {
	if {[catch {
	    set fh [open $rejectFile]
	    foreach line [split [read $fh] "\n"] {
		set l [string trim $line]
		switch -glob -- $l {
		    "" - "\#*" {
		    }
		    default {
			lappend reject [string tolower "${l}"]
		    }
		}
	    }
	    close $fh
	} err]} {
	    puts stderr "brag: Cannot process reject file: $err"
	    exit 3
	}
    }
}

###############################################################################
# Get subjects. Does the same as NNTP::GetSubjects but adds a layer of caching

proc brag::getSubjects {nntpHandle first last subjectArrayName} {

    upvar $subjectArrayName subjects
    set subjectCacheIndex -1
    set linesPerCache 1000

    # Try to read subjects from cache

    for {set i $first} {$i <= $last} {incr i} {
	set index [expr {$i - ($i % $linesPerCache)}]
	if {$index != $subjectCacheIndex} {
	    catch {unset subjectCache}
	    set subjectCacheIndex $index
	    set fileName [file join [getGroupDir] "subjects" $index]
	    if {[file exists $fileName]} {
		if {[catch {
		    set f [open $fileName]
		    set contents [read $f]
		    close $f
		} err]} {
		    puts stderr "Cannot open subject cache: $err"
		    exit 3
		}
		foreach line [split $contents "\n"] {
		    if {[regexp {^([0-9]+)( )(.*)} $line match cnt spc subj]} {
			set subjectCache($cnt) $subj
		    }
		}
	    }
	}

	if {[info exists subjectCache($i)]} {
	    set subjects($i) $subjectCache($i)
	} else {
	    break
	}
    }

    # Read the remaining subjects from the server and save them in the cache

    if {$i <= $last} {
	print "Getting subjects $i-$last from server"
	NNTP::GetSubjects $nntpHandle $i $last subjects
	set subjectCacheIndex [expr {$i - ($i % $linesPerCache)}]
	if {[catch {
	    file mkdir [file join [getGroupDir] "subjects"]
	    set fileName [file join [getGroupDir] "subjects" $subjectCacheIndex]
	    set f [open $fileName "a"]
	} err]} {
	    puts stderr "brag: Cannot open subject cache: $err"
	    exit 3
	}
	for {} {$i <= $last} {incr i} {
	    set index [expr {$i - ($i % $linesPerCache)}]
	    if {$index != $subjectCacheIndex} {
		set subjectCacheIndex $index
		if {[catch {
		    close $f
		    set fileName [file join [getGroupDir] "subjects" $index]
		    set f [open $fileName "a"]
		} err]} {
		    puts stderr "brag: Cannot open subject cache: $err"
		    exit 3
		}
	    }
	    if {[info exists subjects($i)]} {
		set subj $subjects($i)
	    } else {
		set subj ""
	    }
	    if {[catch {puts $f "$i $subj"} err]} {
		puts stderr "brag: Cannot write to subject cache: $err"
		exit 3
	    }
	}
	if {[catch {close $f} err]} {
	    puts stderr "brag: Cannot close subject cache: $err"
	    exit 3
	}
    }
}
	
###############################################################################
# Main

brag::init $argv
brag::getParts

exit 0

#
# End		brag
#
