Newsgrouper

Check-in [20315ff6de]
Login

Check-in [20315ff6de]

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Add option to search files from Internet Archive, etc.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 20315ff6de60e25ce3e2987568a390609f92dae4
User & Date: cmacleod 2025-01-20 11:00:20
Context
2025-01-20
16:01
Move some buttons around. check-in: 872c231b26 user: cmacleod tags: trunk
11:00
Add option to search files from Internet Archive, etc. check-in: 20315ff6de user: cmacleod tags: trunk
2025-01-07
15:42
Fix crash when searching for a group. check-in: 98f1dff49a user: cmacleod tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to scripts/newsutility. 

1
2
3

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26

#!/usr/local/bin/tclsh9.0

# NewsUtility - Compute X-Face images, do ageing of group read statistics.


proc putd s {puts $s}

source nu_config.tcl
source retcl.tm
source distcl.tcl

package require retcl
retcl create redis

set fivemin 300; #seconds
set hour 3600  ; #seconds
set day 86400  ; #seconds
set week 604800; #seconds
set days30 2592000
set counter [clock seconds]

# a little debugging helper
proc printvars args {
    foreach var $args {upvar $var pv[incr n]; puts -nonewline "$var='[set pv$n]' "}
    puts {}
}




|
>















<








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19

20
21
22
23
24
25
26

#!/usr/local/bin/tclsh9.0

# NewsUtility - Compute X-Face images, do ageing of group read statistics,
#               retrieve group charters, search group archive files.

proc putd s {puts $s}

source nu_config.tcl
source retcl.tm
source distcl.tcl

package require retcl
retcl create redis

set fivemin 300; #seconds
set hour 3600  ; #seconds
set day 86400  ; #seconds
set week 604800; #seconds
set days30 2592000


# a little debugging helper
proc printvars args {
    foreach var $args {upvar $var pv[incr n]; puts -nonewline "$var='[set pv$n]' "}
    puts {}
}
︙︙
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67






68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101

























































102
103

            set conversion [open "| uncompface -X | xbmtopbm | pnmtopng" wb+]
            puts -nonewline $conversion $data
            close $conversion write
            set png [read $conversion]
            close $conversion
            return -secs2keep $::days30 $png
        }
        xface {
            set xf [binary decode hex $data]
	    set filename $::xface_dir/[incr ::counter].png
	    exec uncompface -X << $xf | xbmtopbm | pnmtopng > $filename

	    return -secs2keep $::week $filename
        }
        charter {
	    return -secs2keep $::days30 [get_charter $data]
        }






        default {
            error "UNRECOGNISED REQUEST: '$func'"
        }
    }
}

proc get_charter group {

    set hier [lindex [split $group .] 0]
    set url "https://ftp.isc.org/usenet/control/$hier/$group.gz"
    set ctlmsgs [open "| wget -q -O - $url | gunzip"]
    fconfigure $ctlmsgs -translation binary

    while 1 {
        if {[gets $ctlmsgs line] < 0} {
            catch {close $ctlmsgs}
            return {}
        }
        if {[string trim $line] eq "For your newsgroups file:"} break
    }
    gets $ctlmsgs
    gets $ctlmsgs last
    set charter {}
    while {[gets $ctlmsgs line] >= 0} {
        #puts XX$line
        if {$line eq "-- "} break
        if {[string range $line 0 4] eq "From " && $last eq ""} break
        append charter $line "\n"
        set last $line
    }
    catch {close $ctlmsgs}
    return [string trim $charter]
}


























































distcl::serve redis nu execute









<
<
<
<
<
<
<



>
>
>
>
>
>








|















<









>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>



51
52
53
54
55
56
57







58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90

91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158

            set conversion [open "| uncompface -X | xbmtopbm | pnmtopng" wb+]
            puts -nonewline $conversion $data
            close $conversion write
            set png [read $conversion]
            close $conversion
            return -secs2keep $::days30 $png
        }







        charter {
	    return -secs2keep $::days30 [get_charter $data]
        }
        ar_exists {
	    return -secs2keep $::days30 [ar_exists $data]
        }
        ar_find {
	    return -secs2keep $::hour [ar_find {*}$args]
        }
        default {
            error "UNRECOGNISED REQUEST: '$func'"
        }
    }
}

proc get_charter group {

    set hier [group_hier $group]
    set url "https://ftp.isc.org/usenet/control/$hier/$group.gz"
    set ctlmsgs [open "| wget -q -O - $url | gunzip"]
    fconfigure $ctlmsgs -translation binary

    while 1 {
        if {[gets $ctlmsgs line] < 0} {
            catch {close $ctlmsgs}
            return {}
        }
        if {[string trim $line] eq "For your newsgroups file:"} break
    }
    gets $ctlmsgs
    gets $ctlmsgs last
    set charter {}
    while {[gets $ctlmsgs line] >= 0} {

        if {$line eq "-- "} break
        if {[string range $line 0 4] eq "From " && $last eq ""} break
        append charter $line "\n"
        set last $line
    }
    catch {close $ctlmsgs}
    return [string trim $charter]
}

# Check group is valid and return top-level hierarchy
proc group_hier group {
    set group_re {^[[:alnum:]_\-\+]+\.[[:alnum:]_\.\-\+]+$}
    if {[regexp $group_re $group]} {
        return [lindex [split $group .] 0]
    }
    error "Invalid group '$group'"
}

# Check if a group archive file exists
proc ar_exists {group} {
    set hier [group_hier $group]
    set file [file join $::archive_dir $hier $group.mbox.zip]
    return [file readable $file]
}

# Find articles matching a pattern in a group archive file
proc ar_find {group pattern head body nocase} {
    set hier [group_hier $group]
    set file [file join $::archive_dir $hier $group.mbox.zip]
    if {$head && $body} {
        set opts {}
    } elseif {$head} {
        set opts {-H}
    } else {
        set opts {-B}
    }
    if {$nocase} {
        append opts { -i}
    }
    set art {}
    set arts {}
    set prev "\n"

    set command "| unzip -p $file | mboxgrep $opts"
    # escape redirections
    switch -glob $pattern |* - <* - >* - 2>* {set pattern \\$pattern}
    lappend command $pattern

    set input [open $command]
    while {[gets $input line] >= 0} {
        if {$prev eq "\n" && [regexp {^From -?\d+\s*$} $line]} {
            # we found the start of a new article
            if {$art ne {}} {lappend arts $art}
            set art {}
            set prev {}
            if {[llength $arts] >= $::archive_max} break
        } else {
            append art $prev
            set prev "$line\n"
        }
    }
    if {$art ne {}} {lappend arts $art}
    catch {close $input}
    return [encoding convertto $arts]
}

distcl::serve redis nu execute

Changes to scripts/nu_config.tcl.sample. 

1
2

3

# General parameters
set xface_dir /some/path/to/htdocs/xface




|
>


1
2
3
4

# General parameters
set archive_dir /some/directory
set archive_max 500

Changes to scripts/user_stats. 

1
2
3
4
5

6
7
8
9
10
11
12
13
14
15

16
17
18
19
20
21



#!/usr/local/bin/tclsh9.0

# user_stats - count distinct users from the access logs

set totalusers {}

foreach lf [lsort [glob /tmp/log8015_2*gz]] {
    set dayusers {}
    set dayreqs 0
    set if [open "| zcat $lf"]
    while {[gets $if line] >= 0} {
        incr dayreqs
        lassign [split $line] country reg user
        if {$user eq "-"} continue
        dict incr dayusers $user
        dict incr totalusers $user

    }
    close $if
    #puts $dayusers
    puts "$lf\t[dict size $dayusers]	$dayreqs"
}
puts "total\t[dict size $totalusers]"








>










>





|
>
>

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25

#!/usr/local/bin/tclsh9.0

# user_stats - count distinct users from the access logs

set totalusers {}
set countries {}
foreach lf [lsort [glob /tmp/log8015_2*gz]] {
    set dayusers {}
    set dayreqs 0
    set if [open "| zcat $lf"]
    while {[gets $if line] >= 0} {
        incr dayreqs
        lassign [split $line] country reg user
        if {$user eq "-"} continue
        dict incr dayusers $user
        dict incr totalusers $user
        dict set countries $country $user 1
    }
    close $if
    #puts $dayusers
    puts "$lf\t[dict size $dayusers]	$dayreqs"
}
puts "total users: [dict size $totalusers]"
puts "users per country: [dict map {c u} $countries {dict size $u}]"

Changes to server/news_code.tcl.

︙︙
135
136
137
138
139
140
141

142
143
144
145
146
147
148







149


150
151
152
153
154
155
156
157

    {^/(\d+)/grp$} {
        lassign $num_etc - num
        set html [show_group $sock $urec $group $num] }
    {^/post$} {
        set html [compose_new $urec $group] }
    {^/search$} {
        set html [show_art_search $group] }

    {^/do_search$} {
        set html [do_art_search $sock $urec $group] }
    {^/more_search$} {
        set html [more_art_search $urec $group] }
    {^/found/(\d+)$} {
        lassign $num_etc - num
        set html [show_art_found $urec $group $num] }







    {^/ref_list$} {


        set html [do_ref_list $sock $urec $group] }
    {^/rev$} {
        set html [reverse_group $sock $urec $group] }
    {^/hide$} {
        tailcall hide_group $sock $urec $group }
    {^/charter$} {
        set html [show_charter $group] }
    default {








>
|
|
|
<
|


>
>
>
>
>
>
>
|
>
>
|








135
136
137
138
139
140
141
142
143
144
145

146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166

    {^/(\d+)/grp$} {
        lassign $num_etc - num
        set html [show_group $sock $urec $group $num] }
    {^/post$} {
        set html [compose_new $urec $group] }
    {^/search$} {
        set html [show_art_search $group] }
    {^/hist/replies$} -
    {^/hist/list$} {
        set html [search_history $sock $urec $group] }
    {^/arch/(\d+)$} -

    {^/hist/(\d+)$} {
        lassign $num_etc - num
        set html [show_art_found $urec $group $num] }
    {^/arch/(\d+)/raw$} -
    {^/hist/(\d+)/raw$} {
        lassign $num_etc - num
        set html [art_found_raw $urec $group $num] }
    {^/hist/refs$} {
        set html [hist_ref_list $sock $urec $group] }
    {^/arch/replies$} -
    {^/arch/list$} {
        set html [search_archive $sock $urec $group] }
    {^/arch/refs$} {
        set html [arch_ref_list $sock $urec $group] }
    {^/rev$} {
        set html [reverse_group $sock $urec $group] }
    {^/hide$} {
        tailcall hide_group $sock $urec $group }
    {^/charter$} {
        set html [show_charter $group] }
    default {
︙︙
556
557
558
559
560
561
562

563
564
565
566
567
568
569

    if {! [regexp {<[[:graph:]]+@[[:graph:]]+>} $msgid]} {
        return "$html<h4>Invalid message-id.</h4>"
    }

    if [catch {geta mid $msgid} art] {
        return "$html<h4>Article Not Found.</h4>"
    }

    lassign [parse_article $art] headers body
    return [show_article $urec $headers $body]
}

# Show the list of groups most read by all users here
proc top_groups_read {} {









>








565
566
567
568
569
570
571
572
573
574
575
576
577
578
579

    if {! [regexp {<[[:graph:]]+@[[:graph:]]+>} $msgid]} {
        return "$html<h4>Invalid message-id.</h4>"
    }

    if [catch {geta mid $msgid} art] {
        return "$html<h4>Article Not Found.</h4>"
    }
    set art [join $art \n]
    lassign [parse_article $art] headers body
    return [show_article $urec $headers $body]
}

# Show the list of groups most read by all users here
proc top_groups_read {} {
︙︙
825
826
827
828
829
830
831

832
833
834
835
836
837
838
839
840

}

# Show one discussion thread
proc show_thread {urec group start target} {
    if [catch {get art $group $start} art] {
	set sub {}
    } else {

        lassign [parse_article $art] headers body
        set sub [dict get $headers Subject]
        catch {set sub [::mime::field_decode $sub]}
    }

    html "<a id='up' href='/$group' style='font-size: x-large'>$group</a>:"
    html "<span style='font-size: x-large'> [enpre $sub]</span>\n"

    html {<iframe style='position:fixed; left:0%; bottom:0%; height:80%; width:30%' }








>

|








835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851

}

# Show one discussion thread
proc show_thread {urec group start target} {
    if [catch {get art $group $start} art] {
	set sub {}
    } else {
        set art [join $art \n]
        lassign [parse_article $art] headers body
        set sub [dict getdef $headers Subject {}]
        catch {set sub [::mime::field_decode $sub]}
    }

    html "<a id='up' href='/$group' style='font-size: x-large'>$group</a>:"
    html "<span style='font-size: x-large'> [enpre $sub]</span>\n"

    html {<iframe style='position:fixed; left:0%; bottom:0%; height:80%; width:30%' }
︙︙
1037
1038
1039
1040
1041
1042
1043

1044
1045
1046
1047
1048
1049
1050

}

# Generate an article display - this will be put in an iframe
proc get_article {urec group num thr linx} {
    if [catch {get art $group $num} art] {
        return "ARTICLE NOT FOUND: [enpre $art]"
    }

    lassign $urec user can_post params
    dict with params {}

    set html "<head><style type='text/css'>
    body {color: $gen_fg; background-color: $gen_bg}
    .quot {color: $quo_fg; background-color: $quo_bg}
</style></head>"








>








1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062

}

# Generate an article display - this will be put in an iframe
proc get_article {urec group num thr linx} {
    if [catch {get art $group $num} art] {
        return "ARTICLE NOT FOUND: [enpre $art]"
    }
    set art [join $art \n]
    lassign $urec user can_post params
    dict with params {}

    set html "<head><style type='text/css'>
    body {color: $gen_fg; background-color: $gen_bg}
    .quot {color: $quo_fg; background-color: $quo_bg}
</style></head>"
︙︙
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127

    html "\n</body>"
    return $html
}

# Format an article for display
proc show_article {urec headers body} {
    if {$headers eq {}} {
        return {Cannot display post.}
    }
    lassign $urec user can_post params
    set markup [dict get $params mup]
    set reflow [dict get $params flo]
    PutStash u$user markup reflow

    if {[dict exists $headers X-Face]} {
        set facedata [dict get $headers X-Face]
        set from [dict get $headers From]
        set parsed [lindex [::mime::parseaddress $from] 0]
        set addr [dict get $parsed address]
        tsv::set Faces $addr {}

	if {[redis hset faces $addr $facedata]} {
            distcl::prefetch redis nu face $facedata
        }
        html "<img src='/face/[Url_Encode $addr].png' alt='X-Face' style='float:right'>\n"
    }
    foreach hdr {From Newsgroups Subject Date} {
        set field($hdr) [dict get $headers $hdr]
        catch {set field($hdr) [::mime::field_decode $field($hdr)]}
        html "<em>${hdr}: [enpre $field($hdr)]</em><br/>\n"
    }
    #html "<br/>\n<base target='_blank' />"
    html "<br/>\n"
    if {! $reflow} {html "<pre>\n"}
    set in_quote 0
    foreach line $body {
        if {[string index $line 0] eq {>}} {
	    if {! $in_quote} {html {<div class='quot'>}} 
	    set in_quote 1








|



















|



<








1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131

1132
1133
1134
1135
1136
1137
1138

    html "\n</body>"
    return $html
}

# Format an article for display
proc show_article {urec headers body} {
    if {$headers eq {}} {
        return {Cannot display post.<br/><br/>}
    }
    lassign $urec user can_post params
    set markup [dict get $params mup]
    set reflow [dict get $params flo]
    PutStash u$user markup reflow

    if {[dict exists $headers X-Face]} {
        set facedata [dict get $headers X-Face]
        set from [dict get $headers From]
        set parsed [lindex [::mime::parseaddress $from] 0]
        set addr [dict get $parsed address]
        tsv::set Faces $addr {}

	if {[redis hset faces $addr $facedata]} {
            distcl::prefetch redis nu face $facedata
        }
        html "<img src='/face/[Url_Encode $addr].png' alt='X-Face' style='float:right'>\n"
    }
    foreach hdr {From Newsgroups Subject Date} {
        set field($hdr) [dict getdef $headers $hdr {}]
        catch {set field($hdr) [::mime::field_decode $field($hdr)]}
        html "<em>${hdr}: [enpre $field($hdr)]</em><br/>\n"
    }

    html "<br/>\n"
    if {! $reflow} {html "<pre>\n"}
    set in_quote 0
    foreach line $body {
        if {[string index $line 0] eq {>}} {
	    if {! $in_quote} {html {<div class='quot'>}} 
	    set in_quote 1
︙︙
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253

        if {$unopened ne {}} {return [list $unopened $html]}
    }
    return [list {} $html]
}

# generate the buttons to show under an article
proc show_art_foot {urec group num thr linx headers} {
    if {$headers eq {}} return
    lassign $urec user can_post
    set from [dict get $headers From]
    set parsed [lindex [::mime::parseaddress $from] 0]
    set name [dict get $parsed friendly]
    set addr [dict get $parsed address]
    set markup 0
    set reflow 0
    GetStash u$user markup reflow

    html {
    <form action='/' method='post' target='_top' style='display: inline'>}









<

|

|
|








1245
1246
1247
1248
1249
1250
1251

1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263

        if {$unopened ne {}} {return [list $unopened $html]}
    }
    return [list {} $html]
}

# generate the buttons to show under an article
proc show_art_foot {urec group num thr linx headers} {

    lassign $urec user can_post
    set from [dict getdef $headers From {}]
    set parsed [lindex [::mime::parseaddress $from] 0]
    set name [dict getdef $parsed friendly {}]
    set addr [dict getdef $parsed address {}]
    set markup 0
    set reflow 0
    GetStash u$user markup reflow

    html {
    <form action='/' method='post' target='_top' style='display: inline'>}
︙︙
1276
1277
1278
1279
1280
1281
1282
1283





1284
1285
1286
1287
1288
1289
1290


    html "\n<input type=submit value='Post Reply' class='bbut' "
    if {$can_post} {
        html "formaction='/$group/$num/post' />"
    } else {
        html "disabled='disabled' />"
    }
    html "\n<input type=submit value='Block Poster' formaction='/do/block' formtarget='_self' class='bbut' />"





    html "<input type='hidden' name='name' value='[enpre $name]' />"
    html "<input type='hidden' name='address' value='$addr' />"
    html "<input type='hidden' name='group' value='$group' />"
    html "<input type='hidden' name='num' value='$num' />"
    html "<input type='hidden' name='thr' value='$thr' />"

    html "\n<input id='vs' type=submit value='View Source \U01F1FB' formaction='/$group/$num/raw' formtarget='viewsource' class='bbut' />"








|
>
>
>
>
>








1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305


    html "\n<input type=submit value='Post Reply' class='bbut' "
    if {$can_post} {
        html "formaction='/$group/$num/post' />"
    } else {
        html "disabled='disabled' />"
    }
    html "\n<input type=submit value='Block Poster' class='bbut' "
    if {$addr ne {}} {
        html "formaction='/do/block' formtarget='_self' />"
    } else {
        html "disabled='disabled' />"
    }
    html "<input type='hidden' name='name' value='[enpre $name]' />"
    html "<input type='hidden' name='address' value='$addr' />"
    html "<input type='hidden' name='group' value='$group' />"
    html "<input type='hidden' name='num' value='$num' />"
    html "<input type='hidden' name='thr' value='$thr' />"

    html "\n<input id='vs' type=submit value='View Source \U01F1FB' formaction='/$group/$num/raw' formtarget='viewsource' class='bbut' />"
︙︙
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385

}

set colour_defaults {
    gen_bg #add8e6 gen_fg #000000
    new_bg #ffffe0 new_fg #000000
    rep_bg #ffa500 rep_fg #000000
    sel_bg #90ee90 sel_fg #000000
    quo_bg #ffffe0 quo_fg #000000
}
    #add8e6 - lightblue
    #ffffe0 - lightyellow
    #ffa500 - orange
    #90ee90 - lightgreen
    #ffffe0 - lightyellow

# Edit user's preferences
proc edit_prefs {urec sock} {
    lassign $urec user can_post params
    set html "<h3>Preferences for [expr {$can_post ? "User " : "Guest "}] $user</h3>\n"

    dict with params {}








|





|








1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400

}

set colour_defaults {
    gen_bg #add8e6 gen_fg #000000
    new_bg #ffffe0 new_fg #000000
    rep_bg #ffa500 rep_fg #000000
    sel_bg #90ee90 sel_fg #000000
    quo_bg #e4e4e4 quo_fg #000000
}
    #add8e6 - lightblue
    #ffffe0 - lightyellow
    #ffa500 - orange
    #90ee90 - lightgreen
    #e4e4e4 - lightgrey

# Edit user's preferences
proc edit_prefs {urec sock} {
    lassign $urec user can_post params
    set html "<h3>Preferences for [expr {$can_post ? "User " : "Guest "}] $user</h3>\n"

    dict with params {}
︙︙
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714























1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743

	}
    }
    return $missing
}

# Show the form to search for articles in the group archive
proc show_art_search group {
    set html "\n<h3>Find articles in <a href='/$group'>$group</a></h3>\n"
    html {
<form action='do_search' method='post'>
<input type='radio' name='pat' value='0' checked='checked' />Including this Text:
<input type='radio' name='pat' value='1' />Matching this Pattern:
<br/>
<input type='text' name='target' size='50' maxlength='100'/>
<input type=submit value='Search' class='but' />
<br/>
<input type='radio' name='fld' value='subject' checked='checked' />In the Subject
<input type='radio' name='fld' value='from' />In the From (Author)
<input type='radio' name='fld' value='references' />In the References
<input type='hidden' name='end' value='0' />
<input type='hidden' name='pos' value='0' />
<input type='hidden' name='min' value='0' />
</form><br/>
}
    html {<em>Notes:<ul>
    <li>The archives used go back to around 2003, older articles will not be found.</li>
    <li>Search text is case-sensitive.</li>
    <li>Glob-style patterns can be used.  E.g. <strong>[Jj]oe</strong> would
   match either "Joe" or "joe"; the pattern <strong>*this*that*</strong>would
   match any text containing "this" and "that" but only in that order.</li>
    <li>Results are usually in reverse chronological order but <strong>there are some exceptions to this</strong> possibly due to the archive having been loaded out-of-order.</li>
   </ul>}























    return $html
}

# Run a new article search and show the results
proc do_art_search {sock urec group} {
    lassign $urec user can_post
    set missing [GetQuery $sock pat target fld end pos min]
    set missing [GetStash s$user {*}$missing]
    if {[llength $missing]} return
    tailcall art_search $user $group $pat $target $fld $end $pos $min
}

# Produce the next results page for an existing search
proc more_art_search {urec group} {
    lassign $urec user can_post
    set missing [GetStash s$user pat target fld next_end next_pos min]
    if {[llength $missing]} return
    tailcall art_search $user $group $pat $target $fld $next_end $next_pos $min
}

# Start or continue an article search
proc art_search {user group pat target fld end pos min} {
    if {! [string is boolean -strict $pat]} return
    if {$pat} {
        set pattern $target
    } else {
        set pattern *$target*
    }









|

|












|


<

|
|

|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>



|
|




<
|
<
<
<
<
<
<
<
<
<
<
<








1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722

1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760

1761











1762
1763
1764
1765
1766
1767
1768

	}
    }
    return $missing
}

# Show the form to search for articles in the group archive
proc show_art_search group {
    html "\n<h3>Search for <a href='/$group'>$group</a> articles at <a href='https://usenet.blueworldhosting.com/'>BlueWorldHosting</a>, 2013-present</h3>"
    html {
<form action='hist/list' method='post'>
<input type='radio' name='pat' value='0' checked='checked' />Including this Text:
<input type='radio' name='pat' value='1' />Matching this Pattern:
<br/>
<input type='text' name='target' size='50' maxlength='100'/>
<input type=submit value='Search' class='but' />
<br/>
<input type='radio' name='fld' value='subject' checked='checked' />In the Subject
<input type='radio' name='fld' value='from' />In the From (Author)
<input type='radio' name='fld' value='references' />In the References
<input type='hidden' name='end' value='0' />
<input type='hidden' name='pos' value='0' />
<input type='hidden' name='min' value='0' />
</form>
}
    html {<em>Notes:<ul>

    <li>Search text is case-sensitive.</li>
    <li>Glob-style patterns can be used.  E.g. <strong>"[Jj]oe"</strong> would
   match either "Joe" or "joe"; the pattern <strong>"*this*that*"</strong> would
   match any text containing "this" and "that" but only in that order.</li>
    <li>Results are usually in reverse chronological order but <strong>there are some exceptions to this</strong> possibly due to articles having been loaded out-of-order.</li>
   </ul></em>}

    if {! [distcl::get redis nu ar_exists $group]} {return $html}

    html {<hr/>}
    html "\n<h3>Search <a href='/$group'>$group</a> history from <a href='https://archive.org/details/usenethistorical'>The Internet Archive</a>, 1987-2003</h3>"
    html {
Find articles with this text or pattern:<br/>
<form action='arch/list' method='post'>
<input type='text' name='target' size='50' maxlength='100'/>
<input type=submit value='Search' class='but' />
<br/>
<input type='checkbox' name='head' value='1' checked='checked' />In the Headers
<input type='checkbox' name='body' value='1' checked='checked' />In the Body Text
<input type='checkbox' name='nocase' value='1' checked='checked' />Ignoring Case
</form>
}
    html {<em>Notes:<ul>
    <li>Regex-style patterns can be used. 
    E.g. <strong>"Jo. 90"</strong> would match "Joe 90", "Job 90", "Joy 90", etc.;
    <strong>"Jo[ty]"</strong> would match only "Jot" or "Joy";
    <strong>"thi*s"</strong> would match "this" but also "thiiiis" or "ths".</li>
    <li>Patterns which match too many results (e.g. "a") will only return the <strong>most recent 500</strong> matches.</li>
   </ul></em>}
    return $html
}

# Run an article search and show the results
proc search_history {sock urec group} {
    lassign $urec user can_post
    set missing [GetQuery $sock pat target fld end pos min]
    set missing [GetStash s$user {*}$missing]
    if {[llength $missing]} return













    if {! [string is boolean -strict $pat]} return
    if {$pat} {
        set pattern $target
    } else {
        set pattern *$target*
    }
︙︙
1760
1761
1762
1763
1764
1765
1766








1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779

1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816




1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854






1855




1856
1857
1858
1859
1860
1861
1862
1863

1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880

1881



1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904

1905
1906
1907

1908

1909
1910
1911

1912
1913





1914









1915
1916

1917

1918














1919
1920
1921
1922
1923
1924
1925
1926

    # prefetch the articles matched
    foreach numtext $rnumtexts {
        if {[regexp {^(\d+)\s+(.*)$} $numtext - num text]} {
            distcl::prefetch redis na art $group $num
            lappend nums $num
        }
    }









    set html "<h3>Articles in <a href=/$group>$group</a> with <em>$fld</em> matching pattern '[enpre $pattern]'</h3>"

    html [show_arts_found $group $nums]

    PutStash s$user group pat target fld end pos nums next_end next_pos min

    if {$next_end < 0} {
        return [html {<h3>No More Matches</h3>}]
    }

    html "<form action='more_search' method='post'>" {
<input type=submit value='More Matches' class='but' />

</form>}
    return $html
}

# Display the list of articles found by a search
proc show_arts_found {group nums} {

    html {<table><thead>
<tr align='left'><th>Subject</th><th>Author</th><th style='width: 7em'>Date</th></tr>
</thead><tbody>
    }

    foreach num $nums {
        if [catch {geta art $group $num} art] continue
        lassign [parse_article $art] headers body

        foreach hdr {From Subject Date} {
            set field($hdr) [dict get $headers $hdr]
            catch {set field($hdr) [::mime::field_decode $field($hdr)]}
        }
        set tim $field(Date)
        if {[regexp {(\d\d? [[:alpha:]]{3}) (\d{4})} $tim - date year]} {
            set tim "$date $year"
        }
        set url "/$group/found/$num"

        html "<tr><td><a href=$url>[enpre $field(Subject)]</a></td>"
	html "<td>[enpre $field(From)]</td><td>$tim</td></tr>\n"
    }
    html "</tbody></table>\n"
}

# Display one article found by an archive search
proc show_art_found {urec group num} {
    lassign $urec user can_post

    if [catch {geta art $group $num} art] {




        return "ARTICLE NOT FOUND: [enpre $art]"
    }
    lassign [parse_article $art] headers body
    set html [show_article $urec $headers $body]

    set nums $num
    GetStash s$user nums
    set pos [lsearch -sorted -integer -decreasing $nums $num]
    set prev [lindex $nums $pos-1]
    set next [lindex $nums $pos+1]

    html "\n<form action='/do/art_found_raw' method='post' target='_top'>"
    html "\n<input id='nx' type=submit value='Next match' "
    if {$next ne {}} {
        html "formaction='$next' />"
    } else {
        html "disabled='disabled' />"
    }
    html "\n<input id='pv' type=submit value='Previous' "
    if {$prev ne {}} {
        html "formaction='$prev' />"
    } else {
        html "disabled='disabled' />"
    }
    html "\n<input id='bk' type=submit value='Back to list' formaction='/$group/do_search' />"
    html "\n<input id='mu' type=submit value='Markup on/off' formaction='/markup' />"
    html "\n<input id='rf' type=submit value='Wrap on/off' formaction='/reflow' />"
    html {
<input type=submit value='View Source' class='but' />
<input type='hidden' name='group' } "value='$group'" {/>
<input type='hidden' name='num' } "value='$num'" {/>
</form>}

    if {[dict exists $headers Message-ID]} {
        set msgid [dict get $headers Message-ID]
    } else {
        set msgid [dict get $headers Message-Id]
    }






    html "\n<form action='/$group/do_search' method='post' target='_top' style='display: inline'>"




    html "<input type='hidden' name='target' value='$msgid' />"
    html "<input type='hidden' name='min' value='[expr {$num - 100}]' />"
    html {
<input type=submit value='Find replies to this post' />
<input type='hidden' name='pat' value='0' />
<input type='hidden' name='fld' value='references' />
<input type='hidden' name='end' value='0' />
<input type='hidden' name='pos' value='0' />

</form>}

    html "\n<form action='/$group/ref_list' method='post' target='_top' style='display: inline'>"
    html "<input type=submit value='Find earlier posts this one refers to' "
    if {[dict exists $headers References]} {
        set refs [dict get $headers References]
        html "/><input type='hidden' name='refs' value='$refs'/>"
    } else {
        html "disabled='disabled' />"
    }
    html "</form>"

    return [encoding convertto $html]
}

# Display an archive article in source form
proc /do/art_found_raw {group num} {

    if [catch {geta art $group $num} art] {



        return "ARTICLE NOT FOUND: [enpre $art]"
    }
    html "<pre>\n"
    foreach line $art {
        html "[enpre $line]\n"
    }
    html "</pre>\n"
    return [encoding convertto $html]
}

# Generate the list of articles in the References of a found article
proc do_ref_list {sock urec group} {
    lassign $urec user can_post
    set missing [GetQuery $sock refs]
    if {[llength $missing]} return

    set reflist [regexp -all -inline {<[[:graph:]]+@[[:graph:]]+>} $refs]

    foreach ref $reflist {
        distcl::prefetch redis na mid $ref
    }

    set nums {}

    foreach ref $reflist {
        if [catch {geta mid $ref} art] continue
        lassign [parse_article $art] headers

        set xref [dict get $headers Xref]

        if {[regexp "$group:(\\d+)" $xref - num]} {
            distcl::prefetch redis na art $group $num
            lappend nums $num

        }
    }





    set nums [lreverse $nums]









    PutStash s$user nums


    set html "<h3>Articles in <a href=/$group>$group</a> referred to by last article</h3>"
















    html [show_arts_found $group $nums]
}

# Show the group charter, if possible
proc show_charter group {
    set html "\n<h3>Charter for group <a href='/$group'>$group</a></h3>\n"
    set tail [join [lassign [split $group .] hier] .]









>
>
>
>
>
>
>
>



|

|





|
|
>
|




|






|
|










|











|
>
>
>
>
|

|


<
<
<
<
<
<
|

|
|




|
|



|


<
|
|
|
<




|

>
>
>
>
>
>
|
>
>
>
>
|
|
<
<
|
|
|
|
>
|

|













|
>
|
>
>
>
|
|

<
|
<





|











>


|
>
|
>
|
|
|
>
|
|
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
|
|
>
|
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|








1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859






1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875

1876
1877
1878

1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897


1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927

1928

1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001

    # prefetch the articles matched
    foreach numtext $rnumtexts {
        if {[regexp {^(\d+)\s+(.*)$} $numtext - num text]} {
            distcl::prefetch redis na art $group $num
            lappend nums $num
        }
    }
    # now get them
    set arts {}
    foreach num $nums {
        if [catch {geta art $group $num} art] continue
        #lappend arts [parse_article $art]
        lappend arts [join $art \n]
    }
    PutStash f$user arts

    set html "<h3>Articles in <a href=/$group>$group</a> with <em>$fld</em> matching pattern '[enpre $pattern]'</h3>"

    html [show_arts_found $user $group $arts]

    PutStash s$user group pat target fld end pos nums min

    if {$next_end < 0} {
        return [html {<h3>No More Matches</h3>}]
    }

    html "<form action='list' method='post'>\n"
    html "<input type=submit value='More Matches' class='but' />\n"
    html "<input type='hidden' name='end' value='$next_end' />\n"
    html "<input type='hidden' name='pos' value='$next_pos' /></form>\n"
    return $html
}

# Display the list of articles found by a search
proc show_arts_found {user group arts} {

    html {<table><thead>
<tr align='left'><th>Subject</th><th>Author</th><th style='width: 7em'>Date</th></tr>
</thead><tbody>
    }

    set num -1
    foreach art $arts {
        lassign [parse_article $art] headers body

        foreach hdr {From Subject Date} {
            set field($hdr) [dict get $headers $hdr]
            catch {set field($hdr) [::mime::field_decode $field($hdr)]}
        }
        set tim $field(Date)
        if {[regexp {(\d\d? [[:alpha:]]{3}) (\d{4})} $tim - date year]} {
            set tim "$date $year"
        }
        set url "[incr num]"

        html "<tr><td><a href=$url>[enpre $field(Subject)]</a></td>"
	html "<td>[enpre $field(From)]</td><td>$tim</td></tr>\n"
    }
    html "</tbody></table>\n"
}

# Display one article found by an archive search
proc show_art_found {urec group num} {
    lassign $urec user can_post

    set arts {}
    GetStash f$user arts
    set art [lindex $arts $num]
    lassign [parse_article $art] headers body
    if {$headers eq {}} {
        return "ARTICLE NOT FOUND"
    }

    set html [show_article $urec $headers $body]







    html "\n<form action='$num/raw' method='post' target='_top'>"
    html "\n<input id='nx' type=submit value='Next match' "
    if {[incr num] < [llength $arts]} {
        html "formaction='$num' />"
    } else {
        html "disabled='disabled' />"
    }
    html "\n<input id='pv' type=submit value='Previous' "
    if {[incr num -2] >= 0} {
        html "formaction='$num' />"
    } else {
        html "disabled='disabled' />"
    }
    html "\n<input id='bk' type=submit value='Back to list' formaction='list' />"
    html "\n<input id='mu' type=submit value='Markup on/off' formaction='/markup' />"
    html "\n<input id='rf' type=submit value='Wrap on/off' formaction='/reflow' />"

    html "\n<input type=submit value='View Source' class='but' />"
    html "\n<input type='hidden' name='group' value='$group' />"
    html "\n<input type='hidden' name='num' value='[incr num]' />\n</form>"


    if {[dict exists $headers Message-ID]} {
        set msgid [dict get $headers Message-ID]
    } else {
        set msgid [dict getdef $headers Message-Id {}]
    }
    set xref [dict getdef $headers Xref {}]
    if {[regexp "$group:(\\d+)" $xref - xnum]} {
        set min [expr {$xnum - 100}]
    } else {
        set min 0
    }
    html "\n<form action='replies' method='post' target='_top' style='display: inline'>"
    html "\n<input type=submit value='Find replies to this post' "
    if {$msgid eq {}} {
        html "disabled='disabled' />"
    } else {
        html "/>\n<input type='hidden' name='target' value='$msgid' />"
        html "\n<input type='hidden' name='min' value='$min' />"


        html "\n<input type='hidden' name='pat' value='0' />"
        html "\n<input type='hidden' name='fld' value='references' />"
        html "\n<input type='hidden' name='end' value='0' />"
        html "\n<input type='hidden' name='pos' value='0' />"
    }
    html "</form>"

    html "\n<form action='refs' method='post' target='_top' style='display: inline'>"
    html "<input type=submit value='Find earlier posts this one refers to' "
    if {[dict exists $headers References]} {
        set refs [dict get $headers References]
        html "/><input type='hidden' name='refs' value='$refs'/>"
    } else {
        html "disabled='disabled' />"
    }
    html "</form>"

    return [encoding convertto $html]
}

# Display an archive article in source form
proc art_found_raw {urec group num} {
    lassign $urec user can_post

    set arts {}
    GetStash f$user arts
    set art [lindex $arts $num]
    if {$art eq {}} {return "ARTICLE NOT FOUND."}

    html "<pre>\n"

    html [enpre $art]

    html "</pre>\n"
    return [encoding convertto $html]
}

# Generate the list of articles in the References of a found article
proc hist_ref_list {sock urec group} {
    lassign $urec user can_post
    set missing [GetQuery $sock refs]
    if {[llength $missing]} return

    set reflist [regexp -all -inline {<[[:graph:]]+@[[:graph:]]+>} $refs]

    foreach ref $reflist {
        distcl::prefetch redis na mid $ref
    }

    set nums {}
    set arts {}
    foreach ref $reflist {
        if [catch {geta mid $ref} art] continue
        lappend arts [join $art \n]
    }
    set arts [lreverse $arts]
    PutStash f$user arts

    set html "<h3>Articles in <a href=/$group>$group</a> referred to by last article</h3>"

    html [show_arts_found $user $group $arts]
}

# Run a new article search and show the results
proc search_archive {sock urec group} {
    lassign $urec user can_post
    set head 0
    set body 0
    set nocase 0
    set missing [GetQuery $sock target head body nocase]
    if {[llength $missing]} {
        set missing [GetStash f$user arts]
        if {[llength $missing]} return
    } else {
        set head [expr {$head == 1}]
        set body [expr {$body == 1}]
        set nocase [expr {$nocase == 1}]
        set arts [distcl::get redis nu ar_find $group $target $head $body $nocase]
        PutStash f$user arts
    }

    set html "<h3>Articles in <a href=/$group>$group</a> found</h3>"
    html [show_arts_found $user $group $arts]
}

# Generate the list of articles in the References of a found archive article
proc arch_ref_list {sock urec group} {
    lassign $urec user can_post
    set missing [GetQuery $sock refs]
    if {[llength $missing]} return

    set reflist [regexp -all -inline {<[[:graph:]]+@[[:graph:]]+>} $refs]
    set regex "^message-id: +([join $reflist |])"

    set arts [distcl::get redis nu ar_find $group $regex 1 0 1]
    PutStash f$user arts

    set html "<h3>Articles in <a href=/$group>$group</a> referred to by last article</h3>"
    html [show_arts_found $user $group $arts]
}

# Show the group charter, if possible
proc show_charter group {
    set html "\n<h3>Charter for group <a href='/$group'>$group</a></h3>\n"
    set tail [join [lassign [split $group .] hier] .]
︙︙
2001
2002
2003
2004
2005
2006
2007

2008
2009
2010
2011
2012
2013
2014

}

# Start a post in reply to an existing article
proc compose_reply {urec group num} {
    if [catch {get art $group $num} art] {
        return {Post not found.}
    }

    lassign [parse_article $art] headers old_body
    if {$headers eq {}} {
        return {Post not found.}
    }
    set groups [dict get $headers Newsgroups]

    set old_sub [dict get $headers Subject]








>








2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090

}

# Start a post in reply to an existing article
proc compose_reply {urec group num} {
    if [catch {get art $group $num} art] {
        return {Post not found.}
    }
    set art [join $art \n]
    lassign [parse_article $art] headers old_body
    if {$headers eq {}} {
        return {Post not found.}
    }
    set groups [dict get $headers Newsgroups]

    set old_sub [dict get $headers Subject]
︙︙
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273

    }
}

# Parse an article from the news server, return a dict of the headers
# and a list of body lines.
proc parse_article {art} {

    if [catch {::mime::initialize -string [join $art \n]} mt] {
        puts "::mime::initialize FAILED: '$mt'"
        return {}
    }

    if [catch {::mime::getheader $mt} headers] {
        puts "::mime::getheader FAILED: '$headers'"
        return {}








|








2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349

    }
}

# Parse an article from the news server, return a dict of the headers
# and a list of body lines.
proc parse_article {art} {

    if [catch {::mime::initialize -string $art} mt] {
        puts "::mime::initialize FAILED: '$mt'"
        return {}
    }

    if [catch {::mime::getheader $mt} headers] {
        puts "::mime::getheader FAILED: '$headers'"
        return {}
︙︙