- Publicity: Public Only All
nntp-procs.tcl
XoWiki - main library classes and objects
This file defines the following Objects and Classes: ::nntp::Session
, ::nntp::Session
- Location:
- packages/xowiki/tcl/nntp-procs.tcl
- Created:
- 2006-01-10
- Author:
- Gustaf Neumann
- CVS Identification:
$Id: xowiki-procs.tcl,v 1.542.2.180 2024/07/28 17:08:02 gustafn Exp $
Procedures in this file
- Class ::nntp::Session (public)
- nntp::Session instproc destroy (public)
- nntp::Session instproc group (public)
- nntp::Session instproc login (public)
- nntp::Session proc refresh (public)
Detailed information
Class ::nntp::Session (public)
::nx::Class ::nntp::SessionSupport for NNTP session. In essence: 1) login 2) run some commands 3) logout
- Testcases:
- No testcase defined.
nntp::Session method destroy (public)
<instance of nntp::Session> destroyLog-out from the session and destroy the session object.
- Testcases:
- No testcase defined.
nntp::Session method group (public)
<instance of nntp::Session> group nameupdate all entries from the specified group
- Parameters:
- name (required)
- Testcases:
- No testcase defined.
nntp::Session method login (public)
<instance of nntp::Session> login user passwordLog-in with the provided credentials
- Parameters:
- user (required)
- password (required)
- Testcases:
- No testcase defined.
nntp::Session object method refresh (public)
nntp::Session refresh [ -server server ] [ -port port ] \
[ -group group ]Refresh articles in the database with messages from the NNTP news server. ns_section ns/server/${server}/acs/nntp { ns_param NttpUser gustafn ns_param NttpPassword isxqsomzp } ad_schedule_proc -thread t 5m ::nntp::Session refresh
- Switches:
- -server (optional, defaults to
"news.eternal-september.org")- -port (optional, defaults to
"119")- -group (optional, defaults to
"comp.lang.tcl")- Testcases:
- No testcase defined.
Content File Source
::xo::library doc { XoWiki - main library classes and objects @creation-date 2006-01-10 @author Gustaf Neumann @cvs-id $Id: xowiki-procs.tcl,v 1.542.2.180 2024/07/28 17:08:02 gustafn Exp $ } set nntp_group comp.lang.tcl # # Make sure, we have the data model defined # ::xo::db::require table nntp_groups [subst { nntp_id {integer references acs_objects(object_id) on delete cascade primary key} name {[::xo::dc map_datatype text]} last_id {integer default 0} }] ::xo::db::require table nntp_articles [subst { article_id {integer not null} nntp_id {integer references nntp_groups(nntp_id) on delete cascade} dict {[::xo::dc map_datatype text]} }] # # Define an entry for the default nntp_group # if {![::acs::dc list_of_lists -prepare text check_group {select count(*) from nntp_groups where name = :nntp_group}]} { ::xo::dc transaction { set id [acs::dc call acs_object new] xo::dc dml update_group { insert into nntp_groups (nntp_id, name) values (:id, :nntp_group) } } } namespace eval nntp { nx::Class create Session { # # Support for NNTP session. In essence: # 1) login # 2) run some commands # 3) logout # :property server:required :property port:int,required :property {debug:int 1} :method log {severity args} { if {${:debug}} { ns_log $severity "NNTP:" {*}$args } } :method readLine {} { set line [string trimright [ns_connchan read ${:channel}]] ns_log notice "GOT line <$line>" return $line } :method writeLine {line} { set result [ns_connchan write ${:channel} $line\r\n] ns_log notice "SENT line <$line>" return $result } :method init {} { set :channel [ns_connchan connect ${:server} ${:port}] ns_log notice "CONNECTED via channel ${:channel}" set line [:readLine] } :public method destroy {} { # # Log-out from the session and destroy the session object. # ns_log notice "DISCONNECT from channel ${:channel}" :writeLine QUIT ns_connchan close ${:channel} next } :public method login {user password} { # # Log-in with the provided credentials # :writeLine "AUTHINFO USER $user" set line [:readLine] :writeLine "AUTHINFO PASS $password" set line [:readLine] } :method decodeHeader {nr headerString} { # # The value "nr" is just needed for the log messages. # :log notice "HEADER $headerString" set hdr "" foreach line [split $headerString \n] { if {[regexp {^(\S+):\s*(\S.*)$} $line . tag value]} { set value [string trim $value] set start 0 while {1} { set l [regexp -inline -indices -all -start $start {=[?]([^?]+)[?]([^?]+)[?](.*)[?]=} $value] if {[llength $l] == 0} { break } foreach {m charset encoding coded} $l { set charset [string range $value {*}$charset] set encoding [string range $value {*}$encoding] if {$encoding eq "B"} { set value [string replace $value {*}$m [ns_base64decode [string range $value {*}$coded]]] } else { ns_log warning "article $nr: ENCODED WORD" charset $charset encoding $encoding not implemented } set start [lindex $m 1] } } if {$start == 0} { :log notice "article $nr: plain <$value>" } else { :log notice "article $nr: decoded <$value>" } #if {[regexp {^=[?]([^?]+)[?]([^?]+)[?](.*)[?]=$} $value . charset encoding coded]} { # # Encoded word syntax (RFC 2047) # example: =?UTF-8?B?PyBCVUcgLSBUY2w5LjBiMyBMaW51eCAtIGNhbnZhcyBiaW5k?= # #ns_log notice "========= ENCODED WORD" charset $charset encoding $encoding coded $coded # if {$encoding eq "B"} { # set value [ns_base64decode $coded] # :log notice "article $nr: encoded word syntax: DECODED '$value'" # } else { # ns_log warning "article $nr: ENCODED WORD" charset $charset encoding $encoding not implemented # } # :log notice "article $nr: decoded <$value>" #} else { # :log notice "article $nr: plain <$value>" #} :log notice "article $nr: add header <[string tolower $tag]> <$value>" dict set hdr [string tolower $tag] $value } elseif {$line ne ""} { ns_log warning "article $nr: ignore HEADER line <$line>" } } return $hdr } :method readArticle {nr} { # # Read a single article denoted by the numeric value # provided by the NNTP server. # :writeLine "ARTICLE $nr" set raw_lines "" while {1} { set chunk [ns_connchan read ${:channel}] #ns_log notice "CHUNK <$chunk>" if {$chunk eq ""} { ns_log warning "ARTICLE $nr: unexpected empty line" break } append raw_lines $chunk if {[string range $raw_lines end-4 end] eq "\r\n.\r\n"} { #ns_log notice "ARTICLE $nr: --- exact 5 char end" set raw_lines [string range $raw_lines 0 end-5] break } elseif {[string range $raw_lines end-2 end] eq "\n.\n"} { #ns_log notice "ARTICLE $nr: --- exact 3 char end" set raw_lines [string range $raw_lines 0 end-3] break } else { :log notice CHECK last 5 chars '[string range $raw_lines end-4 end]' length [string length [string range $raw_lines end-4 end]] } } regsub -all \r\n [encoding convertfrom utf-8 $raw_lines] \n raw_lines :log notice "RAW\n$raw_lines" set header "" set content "" set eoh 0 set lines [split $raw_lines \n] :log notice "REPLY_LINE [lindex $lines 0]" lassign [lindex $lines 0] status nr msg_id type dict set msg MSG_ID $msg_id foreach line [lrange $lines 1 end] { #:log notice "PARSE LINE <$line>" if {$line eq "."} { break } if {$line eq "" && !$eoh} { set eoh 1 set msg [dict merge $msg [:decodeHeader $nr $header]] continue } if {$eoh} { append content $line \n } else { if {[string is space [string range $line 0 0]]} { :log notice "===== HEADER join '[string range $line 0 0]' -> <$line>" set header [string range $header 0 end-1] append header " " set line [string range $line 1 end] } append header $line \n } } #ns_log notice "ARTICLE $nr: $content" dict set msg BODY $content } :public method group {name} { # # update all entries from the specified group # :writeLine "GROUP $name" lassign [:readLine] status nr available_from available_to groupname ns_log notice "FROM $available_from TO $available_to" if {$available_from eq ""} { error "nntp group '$name': status '$status' available_from must not be empty" } lassign [lindex [acs::dc list_of_lists -prepare text dbqd..get_group_info { select nntp_id, last_id from nntp_groups where name = :name }] 0] nntp_id last_id set count 1000 set fetched_articles [::acs::dc list -prepare integer dbqd..fetch_article_ids { select article_id from nntp_articles where nntp_id = :nntp_id }] ns_log notice "LAST_ID $last_id available_from $available_from, we have [llength $fetched_articles] articles loaded" for {set article_id $available_from} {$article_id <= $available_to} {incr article_id} { if {0 && $last_id > $article_id} { # # Optimization, don't use it, if we want to refetch some articles # continue } if {[incr count -1] < 0} break if {$article_id in $fetched_articles} { continue } ns_log notice FETCH ARTICLE $article_id set d [:readArticle $article_id] ns_log notice INSERT ARTICLE $article_id: $d ::xo::dc transaction { xo::dc dml insert_article { insert into nntp_articles (article_id, nntp_id, dict) values (:article_id, :nntp_id, :d) } xo::dc dml update_last_id { update nntp_groups set last_id = :article_id } } } } :public object method refresh { {-server news.eternal-september.org} {-port 119} {-group comp.lang.tcl} } { # # Refresh articles in the database with messages from the # NNTP news server. # # ns_section ns/server/${server}/acs/nntp { # ns_param NttpUser gustafn # ns_param NttpPassword isxqsomzp # } # # ad_schedule_proc -thread t 5m ::nntp::Session refresh set nntp_user [ns_config "ns/server/[ns_info server]/acs/nntp" NttpUser] if {$nntp_user eq ""} { error "NntpUser is not configured" } set s [nntp::Session new -server $server -port $port] try { $s login $nntp_user [ns_config "ns/server/[ns_info server]/acs/nntp" NttpPassword] $s group $group } finally { $s destroy } } } } ::xo::library source_dependent # # Local variables: # mode: tcl # tcl-indent-level: 4 # indent-tabs-mode: nil # End:
