## Table of Contents

EventLoop
are_arrays_identical
array_to_keyed_list
calculate_ratio_of_month_left
copy_array
day_month_calculations
days_in_month
die
dollar_format
fail_exit
force_width
getargs
keyed_list_to_array
load_stanza_file
next_month_year
parse_rfc822_line
parse_rfc822_mail_address
parse_stanza_line
prompt
prompt_choices
prompt_yn
read_rfc822
read_rfc822_group
read_stanza_body
read_stanza_file
read_stanza_header
require
rfc931
save_stanza_file
spawn_child
store_stanza_field
write_rfc822
write_rfc822_group
write_stanza
xkeylget

[next] [TOC]

## Command

EventLoop - an [incr tcl] class

### Synopsis

EventLoop object -selectTimeout 10 -timeoutCallout {}

inherits

object make_select_list
object run
object stop
object add_trigger file command
object remove_trigger file

### Description

    #@package: EventLoop EventLoop
    #
    # Copyright (C) 1992-1996 NeoSoft.
    #
    # Permission to use, copy, modify, and distribute this software and its
    # documentation for any purpose and without fee is hereby granted, provided
    # that the above copyright notice appear in all copies.  NeoSoft makes no
    # representations about the suitability of this software for any purpose.
    # It is provided "as is" without express or implied warranty.
    ###
    #
    #
    # $Id: neolib.html,v 1.1.1.1 1999/03/31 20:34:36 damon Exp $
    #
    # Incr Tcl Event Loop class.
    #
    # For use with Extended Tcl, but not Wishx, which has its
    # own mechanism (addinput).  A functionally identical EventLoop
    # class for Wishx would be really nice.
    #

        constructor {config} {
        }

        destructor {
        }

        # make a list containing the file handles of all the sockets,
        # pipes, fifos, etc, we are waiting for data from.
        method make_select_list {} {
    	set readSelectList [array names readSelectorCallouts]
        }

        #
        # run an event loop, waiting for input from any of the file handles
        # we've been told to look at, and calling the timeoutCallout,
        # if it exists, every selectTimeout floating point seconds.
        #
        method run {} {
    	set running 1
    	make_select_list

    	while {$running} {

    	    set selectResult  [select $readSelectList "" "" $selectTimeout]
    	    set readReadyList [lindex $selectResult 0]

                if {$readReadyList == ""} {
    		eval $timeoutCallout
    	    }
    	    foreach readReady $readReadyList {
    		set command $readSelectorCallouts($readReady)
    		if {[gets $readReady line] < 0} {
    		    close $readReady
    		    continue
    		}
    		[lindex $command 0] [lindex $command 1] $line
    	    }
    	}
        }

        # stop the event loop after the event that invoked this method
        # finishes
        method stop {} {
    	set running 0
        }

        # add a trigger whereby data on the specified filehandle causes
        # command to execute
        method add_trigger {file command} {
    	set readSelectorCallouts($file) $command
        }

        # remove the trigger on the specified filehandle
        method remove_trigger {file} {
    	unset readSelectorCallouts($file)
        }

        # true while the event loop is running
        protected running 0

        # array where keys are file handles and data are commands to execute
        protected readSelectorCallouts

        # list of file handles to select on as a list
        protected readSelectList

        # timeout interval, default 10 seconds
        public selectTimeout 10

        # timeout callout code, default is to do nothing
        public timeoutCallout ""

[next] [prev] [TOC]

## Command

are_arrays_identical

### Synopsis

are_arrays_identical array1Name array2Name

### Description

    #
    # Return true if two arrays are identical, else false.
    #

        upvar $array1Name array1 $array2Name array2

        # if they don't have the same number of elements, no way are they identical
        if {[array size array1] != [array size array2]} {return 0}

        # For each element in the first array,
        #    If the element isn't in the second array, they're not identical.
        #    If the contents of both elements aren't the same, the arrays aren't
        #      identical.
        # If you get to the end, the arrays are identical.

        set searchId [array startsearch array1]
        while {[array anymore array1 $searchId]} {
    	set elementName [array nextelement array1 $searchId]
    	if ![info exists array2($elementName)] {return 0}
    	if {$array1($elementName) != $array2($elementName)} {
    	    return 0
    	}
        }
        array donesearch sourceArray $searchId
        return 1

[next] [prev] [TOC]

## Command

array_to_keyed_list

### Synopsis

array_to_keyed_list arrayName

### Description

    #
    # Convert an array to a keyed list.  Only handles "flat" keyed lists.
    #

        upvar $arrayName array

        set list ""
        foreach key [array names array] {
            keylset list $key $array($key)
        }
        return $list

[next] [prev] [TOC]

## Command

calculate_ratio_of_month_left

### Synopsis

calculate_ratio_of_month_left month day year

### Description

    #
    # What is the floating point ratio of days left from the specified
    # day, in the specified month, of the specified year?
    #

        set daysInThisMonth [days_in_month $month $year]

        set daysLeftInThisMonth [expr $daysInThisMonth - $day + 1]
        return [expr $daysLeftInThisMonth.0/$daysInThisMonth]

[next] [prev] [TOC]

## Command

copy_array

### Synopsis

copy_array sourceArrayName destArrayName

### Description

    #@package: array_utilities copy_array array_to_keyed_list keyed_list_to_array are_arrays_identical
    #
    # Array Utility Functions
    #
    #
    # $Id: neolib.html,v 1.1.1.1 1999/03/31 20:34:36 damon Exp $
    #
    # Copy the contents of one array into another.
    #

        upvar $sourceArrayName sourceArray $destArrayName destArray

        set searchId [array startsearch sourceArray]
        while {[array anymore sourceArray $searchId]} {
    	set elementName [array nextelement sourceArray $searchId]
    	set destArray($elementName) sourceArray($elementName)
        }
        array donesearch sourceArray $searchId

[next] [prev] [TOC]

## Command

day_month_calculations

### Synopsis

day_month_calculations clock thisMonthVar thisYearVar daysInThisMonthVar daysLeftInThisMonthVar ratioLeftVar nextMonthMonthVar nextMonthYearVar

### Description

    #
    # Given a integer-seconds-since-1970 and the names of some variables,
    # return in those variables the month number (1-12), the year number,
    # the days in the current month (28-31), the days left in this month,
    # the ratio of days left in the month, the month number (1-12) of
    # the month following this date's month, and the year number of the month
    # following this date's month.
    #

        upvar $thisMonthVar thismonth
        upvar $thisYearVar thisyear
        upvar $daysInThisMonthVar daysInThisMonth
        upvar $daysLeftInThisMonthVar daysLeftInThisMonth
        upvar $ratioLeftVar ratioLeft
        upvar $nextMonthMonthVar nextmonth
        upvar $nextMonthYearVar nextyear

        lassign [fmtclock $clock "%m %d %Y"] thismonth thisday thisyear
        scan $thismonth %d thismonth
        scan $thisday %d thisday

        next_month_year $thismonth $thisyear nextmonth nextyear
        set monthStartSeconds [convertclock $nextmonth/1/$nextyear]

        set daysInThisMonth [days_in_month $thismonth $thisyear]

        set daysLeftInThisMonth [expr $daysInThisMonth - $thisday + 1]
        set ratioLeft [expr $daysLeftInThisMonth.0/$daysInThisMonth]

[next] [prev] [TOC]

## Command

days_in_month

### Synopsis

days_in_month month year

### Description

    #
    # How many days are in the specified month, in the specified year?
    #

        switch $month {
    	1 {return 31}
    	2 {
    	    if {$year % 4 == 0} {
    		return 29
    	    } else {
    		return 28
    	    }
    	}
    	3 {return 31}
    	4 {return 30}
    	5 {return 31}
    	6 {return 30}
    	7 {return 31}
    	8 {return 31}
    	9 {return 30}
           10 {return 31}
           11 {return 30}
           12 {return 31}
        }
        error "month out of range ($month)"

[next] [prev] [TOC]

## Command

die

### Synopsis

die message {exitStatus 1}

### Description

        puts stderr $message
        exit $exitStatus

[next] [prev] [TOC]

## Command

dollar_format

### Synopsis

dollar_format number

### Description

    #
    # format a number and return it as a dollar field (two digits precision
    # to the right of the decimal place.)
    #

        return [format "%.2f" $number]

[next] [prev] [TOC]

## Command

fail_exit

### Synopsis

fail_exit command {exitStatus 1}

### Description

    #@package: catchers fail_exit die
    #
    # Copyright (C) 1992-1996 NeoSoft.
    #
    # Permission to use, copy, modify, and distribute this software and its
    # documentation for any purpose and without fee is hereby granted, provided
    # that the above copyright notice appear in all copies.  NeoSoft makes no
    # representations about the suitability of this software for any purpose.
    # It is provided "as is" without express or implied warranty.
    # $Id: neolib.html,v 1.1.1.1 1999/03/31 20:34:36 damon Exp $
    #
    #  fail_exit command [exitStatus]
    #      execute command and, if it gets a tcl error, write the program
    #      name and error message to stderr and exit the program.
    #      If exit is taken, exit status is 1 unless specified.
    #

        if {[catch {uplevel $command} result] == 1} {
            global argv0
    	puts stderr "$argv0: $result"
    	exit $exitStatus
        }

[next] [prev] [TOC]

## Command

force_width

### Synopsis

force_width string width

### Description

    #@package: neo_misc_procs force_width dollar_format
    #
    # Copyright (C) 1992-1996 NeoSoft.
    #
    # Permission to use, copy, modify, and distribute this software and its
    # documentation for any purpose and without fee is hereby granted, provided
    # that the above copyright notice appear in all copies.  NeoSoft makes no
    # representations about the suitability of this software for any purpose.
    # It is provided "as is" without express or implied warranty.
    #
    # return a string forceed to a specified width either by padding, if it
    # is too short, or by truncation, if it is too long.
    #

        return [crange [format "%-${width}s" $string] 0 $width-1]

[next] [prev] [TOC]

## Command

getargs

### Synopsis

getargs arrayName argList

### Description

    #@package: getargs getargs
    #
    # Copyright (C) 1992-1996 NeoSoft.
    #
    # Permission to use, copy, modify, and distribute this software and its
    # documentation for any purpose and without fee is hereby granted, provided
    # that the above copyright notice appear in all copies.  NeoSoft makes no
    # representations about the suitability of this software for any purpose.
    # It is provided "as is" without express or implied warranty.
    # $Id: neolib.html,v 1.1.1.1 1999/03/31 20:34:36 damon Exp $
    #
    # parses an arglist of key-value pairs where the key starts with a
    # dash and the value must always be present.
    #
    # we want to use it in this manner
    #
    # dialog_box -bitmap @/bitmap -text "hi there" -suppress 1
    #
    # in dialog_box,
    #
    # proc dialog_box {blah blah blah args} {}
    comment {#     getargs $args parms}
    comment {# }
    #
    # and have the parms array set as follows:
    #
    # bitmap=@/bitmap
    # text="hi there"
    # suppress="1"
    #
    #

        upvar $arrayName array

        set length [llength $argList]
        if {$length % 2 != 0} {
            error "list of key-value pairs is missing a value"
        }
        for {set i 0} {$i < $length} {incr i 2} {
            set key [lindex $argList $i]
            if {[cindex $key 0] != "-"} {
                error "key '$key' of key-value pairs doesn't start with '-'"
            }
            set array([crange $key 1 end]) [lindex $argList [expr $i + 1]]
        }

[next] [prev] [TOC]

## Command

keyed_list_to_array

### Synopsis

keyed_list_to_array list arrayName

### Description

    #
    # Convert a keyed list to an array.  Only handles "flat" keyed lists.
    #

        upvar $arrayName array

        foreach key [keylkeys list] {
            set array($key) [keylget list $key]
        }

[next] [prev] [TOC]

## Command

load_stanza_file

### Synopsis

load_stanza_file fileName arrayVarName

### Description

    #
    # load_stanza_file and save_stanza_file work differently from the
    # above.  these guys read the stanza bodies into keyed lists indexed
    # by the header names through an array
    #
    #
    #
    # load_stanza_file
    #
    # load in a stanza file where the stanza headers becomne array names
    # and the bodies become keyed lists
    #
    # slight optimization hack was to append up the list instead of
    # keylsetting it, don't know if that really helped or not
    #

        upvar $arrayVarName stanzaArray

        set fp [open $fileName]
        while 1 {
            if {[read_stanza_header $fp section] == 0} {
                close $fp
                return
            }
            set keyedList ""
            while {[gets $fp line] >= 0} {
                if ![parse_stanza_line $line key value] break
                lappend keyedList "$key $value"
            }
            set stanzaArray($section) $keyedList
        }

[next] [prev] [TOC]

## Command

next_month_year

### Synopsis

next_month_year currentMonth currentYear nextMonthVar nextMonthYearVar

### Description

    #@package: timedate-utility next_month_year days_in_month calculate_ratio_of_month_left day_month_calculations
    #
    # Copyright (C) 1992-1996 NeoSoft.
    #
    # Permission to use, copy, modify, and distribute this software and its
    # documentation for any purpose and without fee is hereby granted, provided
    # that the above copyright notice appear in all copies.  NeoSoft makes no
    # representations about the suitability of this software for any purpose.
    # It is provided "as is" without express or implied warranty.
    #
    # Time/Date utility functions
    #
    # $Id: neolib.html,v 1.1.1.1 1999/03/31 20:34:36 damon Exp $
    #
    #
    #
    # given the current month and year and the names of two variables,
    # put in the first the numeric month following this one and in the
    # second, the year of that month.
    #

        upvar $nextMonthVar nextMonth
        upvar $nextMonthYearVar nextMonthYear

        set nextMonthYear $currentYear
        set nextMonth $currentMonth

        if {$nextMonth < 12} {
    	incr nextMonth
        } else {
    	set nextMonth 1
    	incr nextMonthYear
        }

[next] [prev] [TOC]

## Command

parse_rfc822_line

### Synopsis

parse_rfc822_line line keyVar valueVar

### Description

    #@package: rfc822 parse_rfc822_line read_rfc822_group read_rfc822 write_rfc822_group write_rfc822 parse_rfc822_mail_address
    #
    # Copyright (C) 1992-1996 NeoSoft.
    #
    # Permission to use, copy, modify, and distribute this software and its
    # documentation for any purpose and without fee is hereby granted, provided
    # that the above copyright notice appear in all copies.  NeoSoft makes no
    # representations about the suitability of this software for any purpose.
    # It is provided "as is" without express or implied warranty.
    #
    # we really need to rewrite this in C and be truly RFC-822 compliant,
    # it's a pig.
    #
    # RFC noncompliance issues: Line order isn't maintained, multiple
    # lines with the same key aren't supported.
    # There may be stuff in there about quoting, too.
    #
    #
    # parse_rfc822_line
    #
    # Given a line of RFC822 header text and the names of two variables,
    # parse the key into one and the value into the other.
    #
    # Warning, can't do multiple line messages unless line argument contains
    # all necessary lines.
    #
    #

        upvar $keyVar key
        upvar $valueVar value

        set key ""
        set colon [string first ":" $line]
        if {$colon < 2} {
    	return 0
        }
        set key [string trim [string range $line 0 [expr $colon-1]]]
        set value [string trim [string range $line [expr $colon+1] end]]
        return 1

[next] [prev] [TOC]

## Command

parse_rfc822_mail_address

### Synopsis

parse_rfc822_mail_address line emailAddressVar fullNameVar

### Description

    #
    # parse_rfc822_mail_address
    #
    # take the body of an address line and convert it into a name and address
    #

        upvar $emailAddressVar emailAddress
        upvar $fullNameVar fullName

        # in the form "Ellyn Jones <ellyn@NeoSoft.com>"?
        if {[regexp {(.*) <(.*)>} $line dummy fullName emailAddress]} {
            set emailAddress [string tolower $emailAddress]
            return
        }

        # in the form "ellyn@NeoSoft.com (Ellyn Jones)"?
        if {[regexp {(.*) \((.*)\)} $line dummy emailAddress fullName]} {
            set emailAddress [string tolower $emailAddress]
            return
        }

        # hmm, take whatever's there as the reply address
        set emailAddress [string tolower $line]
        set fullName $emailAddress

[next] [prev] [TOC]

## Command

parse_stanza_line

### Synopsis

parse_stanza_line line keyVarName dataVarName

### Description

    # parse_stanza_line
    #
    # given a line and the names of key and value variables, put
    # the key and value in variables and return 1, else 0 or error
    #

        upvar $keyVarName key
        upvar $dataVarName value

        if {[string trim $line] == ""} {return 0}
        if {[cindex $line 0] == "\["} {
            error "called parse_stanza_line with a header line '$line'"
        }

        set separator [string first "=" $line]
        if {$separator < 2} {
            error "malformed stanza line '$line'"
        }
        set key [string trim [string range $line 0 [expr $separator-1]]]
        set value [string trim [string range $line [expr $separator+1] end]]
        return 1

[next] [prev] [TOC]

## Command

prompt

### Synopsis

prompt promptText varName {default ""}

### Description

    #@package: prompts prompt prompt_yn prompt_choices
    #
    # Copyright (C) 1992-1996 NeoSoft.
    #
    # Permission to use, copy, modify, and distribute this software and its
    # documentation for any purpose and without fee is hereby granted, provided
    # that the above copyright notice appear in all copies.  NeoSoft makes no
    # representations about the suitability of this software for any purpose.
    # It is provided "as is" without express or implied warranty.
    #
    # prompt - given some prompt text, the name of a variable, and a possible
    # default value, emit the text, read a line into the named variable and,
    # if an empty string is entered, use the default instead, and set the
    # result into the named variable.
    #

        upvar $varName line
        set line ""

        if {$default == ""} {
            puts stdout "$promptText: " nonewline
        } else {
            puts stdout "$promptText \[$default\]: " nonewline
        }
        if {[gets stdin line] < 0} return
        if {$line == ""} {
            set line $default
        }

[next] [prev] [TOC]

## Command

prompt_choices

### Synopsis

prompt_choices promptText choiceList {default ""}

### Description

    #
    # prompt_choices - emit some prompt text and get a selection of one
    # of a number of responses.
    #

        while 1 {
    	set nChoices 0
    	echo $promptText
    	foreach element $choiceList {
    	    echo "  $nChoices $element"
    	    incr nChoices
    	}
    	prompt "Your selection?" input $default
    	if {([catch {set choice [lindex $choiceList $input]} result] == 1) ||  ($choice == "" && $default != "")} {
    	    echo "Please enter a number between 1 and $nChoices."
    	    continue
    	}
    	if {$choice == ""} {return $default}
    	return $choice
        }

[next] [prev] [TOC]

## Command

prompt_yn

### Synopsis

prompt_yn promptText {default ""}

### Description

    #
    # prompt_yn - emit some prompt text and get a yes or no response,
    # returning 1 for yes and 0 for no.
    #

        while 1 {
            if {$default == ""} {
                puts stdout "$promptText (y/n): " nonewline
            } else {
                puts stdout "$promptText (y/n) \[$default\]: " nonewline
            }
            if {[gets stdin line] < 0} return
            if {$line == ""} {set line $default}
            set char [string tolower [cindex $line 0]]
            if {$char == "n"} {return 0}
            if {$char == "y"} {return 1}
            echo "Please answer y)es or n)o"
        }

[next] [prev] [TOC]

## Command

read_rfc822

### Synopsis

read_rfc822 fileName arrayVarName

### Description

    #
    # read_rfc822
    #
    # load in a file containing one rfc822 group
    #

        upvar $arrayVarName rfcArray

        set fp [open $fileName]
        read_rfc822_group $fp rfcArray
        close $fp

[next] [prev] [TOC]

## Command

read_rfc822_group

### Synopsis

read_rfc822_group fp arrayVarName

### Description

    #
    # read_rfc822_group
    #
    # given a filehandle and an array name, read the file, pulling key-value
    # pairs and putting them into the named array, returning when an empty
    # line or EOF is found
    #
    #

        upvar $arrayVarName rfcArray
        set success 0

        while {[gets $fp line] >= 0} {
            if {$line == ""} break

    	set firstchar [cindex $line 0]
    	if {$firstchar == " " || $firstchar == "\t"} {
    	    if {$key != ""} {
    	        append rfcArray($key) "\n$line"
    	    } else {
    		puts stderr "rfc-822 line starts with whitespace with no prior key '$line'"
    	    }
    	    continue
    	}
            set key ""
            set colon [string first ":" $line]
            if {$colon < 2} {
                puts stderr "malformed rfc-822 line '$line'"
            }
            set success 1
            set key [string trim [string range $line 0 [expr $colon-1]]]
            set value [string trim [string range $line [expr $colon+1] end]]
            set rfcArray($key) $value
        }
        return $success

[next] [prev] [TOC]

## Command

read_stanza_body

### Synopsis

read_stanza_body fp arrayVarName

### Description

    # read_stanza_body
    #
    # given a filehandle and an array name, read the file, pulling key-value
    # pairs and putting them into the named array, returning when an empty
    # line or EOF is found
    #
    #

        upvar $arrayVarName stanzaArray
        set success 0

        while {[gets $fp line] >= 0} {
            if ![parse_stanza_line $line key value] break
            set success 1
            set stanzaArray($key) $value
        }
        return $success

[next] [prev] [TOC]

## Command

read_stanza_file

### Synopsis

read_stanza_file fileName arrayVarPrefix {global ""}

### Description

        set upLevel "2"
        if {$global != ""} {set upLevel "#0"}
        set fp [open $fileName]
        while 1 {
            if {[read_stanza_header $fp section] == 0} {
                close $fp
                return
            }
            store_stanza_field $arrayVarPrefix$section $upLevel ID $section
            while {[gets $fp line] >= 0} {
                if ![parse_stanza_line $line key value] break
                store_stanza_field $arrayVarPrefix$section $upLevel $key $value
            }
        }

[next] [prev] [TOC]

## Command

read_stanza_header

### Synopsis

read_stanza_header fp headerVarName

### Description

    #@package: stanza read_stanza_header read_stanza_body read_stanza_file load_stanza_file write_stanza save_stanza_file
    #
    # Copyright (C) 1992-1996 NeoSoft.
    #
    # Permission to use, copy, modify, and distribute this software and its
    # documentation for any purpose and without fee is hereby granted, provided
    # that the above copyright notice appear in all copies.  NeoSoft makes no
    # representations about the suitability of this software for any purpose.
    # It is provided "as is" without express or implied warranty.
    # $Id: neolib.html,v 1.1.1.1 1999/03/31 20:34:36 damon Exp $
    #
    # we really need to rewrite this in C and be truly stanza compliant,
    # it's kind of a pig.
    #
    # stanza noncompliance issues: lots
    #
    # seems to work, though.
    #
    # read_stanza_header
    #
    # given a filehandle and an array name, read the file, pulling key-value
    # pairs and putting them into the named array, returning when an empty
    # line or EOF is found
    #
    #

        upvar $headerVarName headerVar

        if {[gets $fp line] <= 0} {return 0}
        if {[string index $line 0] != "\["} {
            error "malformed stanza file - no '[' in header"
        }
        if {[cindex $line [clength $line]-1] != "]"} {
            error "malformed stanza file - no ']' in header"
        }
        set headerVar [crange $line 1 [clength $line]-2]
        return 1

[next] [prev] [TOC]

## Command

require

### Synopsis

require commandName

### Description

    #@package: libmanager require
    #
    # Copyright (C) 1992-1996 NeoSoft.
    #
    # Permission to use, copy, modify, and distribute this software and its
    # documentation for any purpose and without fee is hereby granted, provided
    # that the above copyright notice appear in all copies.  NeoSoft makes no
    # representations about the suitability of this software for any purpose.
    # It is provided "as is" without express or implied warranty.
    #
    # This little thing will force the autoloading of the specified command,
    # without actually executing it.
    #

        # already loaded?
        if {[info commands $commandName] != ""} return

        # get it
        if ![auto_load $commandName] {
    	error "couldn't auto_load $commandName"
        }

[next] [prev] [TOC]

## Command

rfc931

### Synopsis

rfc931 fp resultVar

### Description

    #@package: rfc931 rfc931
    #
    # Copyright (C) 1992-1996 NeoSoft.
    #
    # Permission to use, copy, modify, and distribute this software and its
    # documentation for any purpose and without fee is hereby granted, provided
    # that the above copyright notice appear in all copies.  NeoSoft makes no
    # representations about the suitability of this software for any purpose.
    # It is provided "as is" without express or implied warranty.
    #
    # Perform an rfc931 authentication request on the socket bound to the
    # specified filehandle.  Returns username and hostname if found,
    # username and ip if no hostname is found, or an empty string if
    # the remote site isn't running an rfc931 authentication server.
    #
    # $Id: neolib.html,v 1.1.1.1 1999/03/31 20:34:36 damon Exp $
    #

        upvar $resultVar result

        lassign [fstat $fp localhost] localAddr localPort
        lassign [fstat $fp remotehost] remoteAddr remotePort

        if {[catch {lassign [server_open -myip $localAddr $remoteAddr ident] readIdent writeIdent} result] == 1} {
    	global errorCode errorInfo
    	if {[lindex $errorCode 1] == "ECONNREFUSED"} {return 0}
    	error $result $errorInfo $errorCode
        }
        set remoteName [server_info address_name $remoteAddr]

        puts $writeIdent "$remotePort,$localPort\r"
        close $writeIdent

        if {[gets $readIdent authLine] < 0} {
    	close $readIdent
    	set result "read failed"
    	return 0
        }

        set result $authLine
        if {[scan $authLine {%u , %u : USERID :%*[^:]:%s} remote local user] != 3} {
    	close $readIdent
    	return 0
        }

        if {$remote != $remotePort || $local != $localPort} {
    	close $readIdent
    	set result "ports didn't match"
    	return 0
        }

        if {[cindex $user end] == "\r"} {
    	set user [crange $user 0 end-1]
        }
        set result $user@$remoteName
        close $readIdent
        return 1

[next] [prev] [TOC]

## Command

save_stanza_file

### Synopsis

save_stanza_file fileName arrayVarPrefix {global ""}

### Description

    #
    # save_stanza_file
    #
    # save a stanza file where the stanza headers come from an array's keys
    # and the bodies are from keyed lists indexed by the keys
    #

        set upVar "1"
        if {$global != ""} {set upVar "#0"}
        set varPrefixLength [string length $arrayVarPrefix]

        set fp [open $fileName w]
        foreach arrayVarName [uplevel $upVar "info vars $arrayVarPrefix*"] {
            upvar $upVar $arrayVarName stanzaArray

            set setName [string range $arrayVarName $varPrefixLength end]

    	puts $fp "\[$setName\]"
            foreach key [array names stanzaArray] {
                if {[cindex $key 0] != "_"} {
    	        puts $fp "$key=$stanzaArray($key)"
    	    }
    	}
            puts $fp ""
        }
        close $fp

[next] [prev] [TOC]

## Command

spawn_child

### Synopsis

spawn_child command stdinPipeVarName stdoutPipeVarName stderrPipeVarName

### Description

    #@package: spawn_child spawn_child
    #
    # Copyright (C) 1992-1996 NeoSoft.
    #
    # Permission to use, copy, modify, and distribute this software and its
    # documentation for any purpose and without fee is hereby granted, provided
    # that the above copyright notice appear in all copies.  NeoSoft makes no
    # representations about the suitability of this software for any purpose.
    # It is provided "as is" without express or implied warranty.
    #
    # spawn_child - fork a tcl subprocess, redirecting standard input,
    # output and error to pipes.
    #
    # Three variable names are specified.
    # Within those variables spawn_child writes the filehandles of pipes that
    # correspond to standard input, standard output and standard error of
    # the subprocess.
    #

        upvar $stdinPipeVarName stdinPipe  $stdoutPipeVarName stdoutPipe  $stderrPipeVarName stderrPipe

        pipe childStdinPipe stdinPipe
        pipe stdoutPipe childStdoutPipe
        pipe stderrPipe childStderrPipe

        if {[set childPid [fork]] == 0} {

            dup $childStdinPipe stdin
            close $childStdinPipe

            dup $childStdoutPipe stdout
            close $childStdoutPipe

            dup $childStderrPipe stderr
            close $childStderrPipe

            eval "execl $command"
        }
        return $childPid

[next] [prev] [TOC]

## Command

store_stanza_field

### Synopsis

store_stanza_field varName upLevel key value

### Description

        upvar $upLevel $varName myArray

        set myArray($key) $value

[next] [prev] [TOC]

## Command

write_rfc822

### Synopsis

write_rfc822 fileName arrayVarName

### Description

    #
    # write_rfc822
    #
    # write out a file containing one rfc822 group
    #

        upvar $arrayVarName rfcArray

        set fp [open $fileName w]
        write_rfc822_group $fp rfcArray
        close $fp

[next] [prev] [TOC]

## Command

write_rfc822_group

### Synopsis

write_rfc822_group fp arrayVarName

### Description

    #
    # write_rfc822_group
    #
    # given a filehandle and an array name, write the file, pulling key-value
    # pairs from the named array, returning when finished.
    #
    #

        upvar $arrayVarName rfcArray

        foreach name [array names rfcArray] {
            set data [split $rfcArray($name) "\n"]
            puts $fp "$name: [lindex $data 0]"
            foreach additionalLine [lrange $data 1 end] {
                puts $fp "\t$additionalLine"
            }
        }
        puts $fp ""

[next] [prev] [TOC]

## Command

write_stanza

### Synopsis

write_stanza fp headerName arrayVarName

### Description

    #
    # write_stanza
    #
    # given a filehandle, an array name containing stanza elements
    # and a stanza header name, write it out
    #
    #

        upvar $arrayVarName stanzaArray

        puts $fp "\[$headerName\]"
        foreach name [array names stanzaArray] {
            puts $fp "$name=$rfcArray($name)"
        }
        puts $fp ""

[prev] [TOC]

## Command

xkeylget

### Synopsis

xkeylget keylistName args

### Description

    #
    #
    # Copyright (C) 1992-1996 NeoSoft.
    #
    # Permission to use, copy, modify, and distribute this software and its
    # documentation for any purpose and without fee is hereby granted, provided
    # that the above copyright notice appear in all copies.  NeoSoft makes no
    # representations about the suitability of this software for any purpose.
    # It is provided "as is" without express or implied warranty.
    #
    # $Id: neolib.html,v 1.1.1.1 1999/03/31 20:34:36 damon Exp $
    #
    #@package: xkeylget xkeylget

        upvar $keylistName keylist
        if {[llength $args] % 2 != 0} {error "odd number of key-varname pairs"}
        while {$args != ""} {
            set elementName [lindex $args 0]
            set varName [lindex $args 1]
            set args [lrange $args 2 end]
            keylget keylist $elementName value
            uplevel set $varName [list $value]
        }