\ program for checking for Usenet postings, and for reposting these \ articles to an NNTP server if it does not have them. \ My news server failed to propagate some of my postings, so I wrote a \ program that checks another news server for these postings, and \ optionally also reposts them there. Here is the program. It has \ only been tested with gforth 0.6.2 and 1.5 news servers, and it \ expects a ~/Articles file in the format created by xrn, so it is not \ very general. \ Usage: \ #Check for postings: \ gforth repost.fs -e "repost user pass nntp-server bye" \ #user and pass are used for authentication on the nntp server \ #nntp-server is the nntp server \ #The Message-Ids and everything else of the articles come from \ # ~/Articles, and the first article we look at is \ # (earlier ones are skipped). \ #Reposting: \ #set up LANG if your Articles file contains UTF-8: \ export LANG=en_US.utf8 \ #repost within 7 days (keeping the Date: header): \ gforth repost.fs -e "' query-post is posting-absent repost user pass nntp-server bye" \ #repost later (rewriting Date: into X-Original-Date:): \ gforth repost.fs -e "' x-orig-date is fix-date ' query-post is posting-absent repost user pass nntp-server bye" \ When reposting, REPOST shows you the message and then waits; if you \ type 'y', it posts the message, otherwise it doesn't. If you later \ decide you want to post it after all, just run repost again. \ Assumes that the articles reside in ~/Articles in the format used by \ xrn (pretty much literal without escaped '.' at the start of a line, \ starting with "\n\nFrom ", but without escaped "From "). [undefined] parse-name [if] : parse-name parse-word ; [endif] [undefined] s+ [if] : s+ { addr1 u1 addr2 u2 -- addr u } u1 u2 + allocate throw { addr } addr1 addr u1 move addr2 addr u1 + u2 move addr u1 u2 + ; : append { addr1 u1 addr2 u2 -- addr u } addr1 u1 u2 + dup { u } resize throw { addr } addr2 addr u1 + u2 move addr u ; [endif] require unix/socket.fs s" ~/Articles" slurp-file 2constant articles 119 constant nntp 1024 constant status-buf-len create status-buf status-buf-len 2 + chars allot : back-search ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 flag ) \ like SEARCH, but searches backwards from c-addr1 u1; yes, this \ can buffer-underflow 2>r 2dup begin dup r@ >= while 2dup 2r@ string-prefix? if 2swap 2drop 2r> 2drop true exit endif -1 /string repeat 2drop 2r> 2drop false ; : read-status { sock -- ior } sock stdout = if \ for debugging 0 exit endif status-buf status-buf-len sock read-line throw 0= -39 and throw { len } status-buf c@ [char] 1 [char] 3 1+ within if status-buf len type cr 0 else status-buf len type cr -21 \ unsupported operation endif ; : start-articles { d: start-id d: articles -- d: rest-articles } \ rest-articles are the articles beginning at start-id s\" \nMessage-ID: " start-id s+ s\" \n" append { d: line } articles line search 0= -32 and throw s\" \n\nFrom " back-search 0= -32 and throw ; : header { d: s -- d: h } \ h is the substring that may be a header s 1 /string s\" \n\n" search 0= if false exit endif >r drop s r> - ; : header? ( 2s -- f ) \ true if string is the start of the header of an article header { d: h } h s\" \nFrom: " search >r 2drop h s\" \nSubject: " search >r 2drop r> r> and ; : news-header? ( 2s -- f ) header s\" \nNewsgroups: " search nip nip ; : clean-article ( c-addr1 u1 -- c-addr2 u2 ) \ remove trailing newlines, except one BEGIN dup WHILE 1- 2dup + c@ #lf <> UNTIL 1+ THEN 1+ ; : split-article { d: articles -- 2rest 2article flag } \ true if an article was found articles nip 0= if 0 0 0 0 false exit endif articles 2 /string begin ( rest ) s\" \n\nFrom " search 0= if clean-article 0 0 2swap true exit endif 2dup header? if ( rest1 ) articles 2over nip - true exit endif 1 /string again ; : get-field { d: article d: field -- d: value } article field dup >r search assert( dup ) drop r> /string 2dup #lf scan nip - ; : insert-string { d: article d: rest d: ins sock -- rest } article rest nip - sock write-file throw ins sock write-file throw rest ; : x-orig-date { d: article sock -- rest } \ replace the Date: field with X-Original-Date: article s\" \nDate: " search if article 2swap 1 /string s" X-Original-" sock insert-string endif ; defer fix-date ' drop is fix-date : post { d: article sock -- } s" POST" sock write-line throw sock read-status throw article 2 /string sock fix-date begin ( rest ) 2dup s\" \n." search while 1 /string s" ." sock insert-string repeat 2drop sock write-file throw s" ." sock write-line throw sock read-status drop ; : report { d: article d: mid sock -- } mid type space article s\" \nNewsgroups: " get-field type cr ; : query-post { d: article d: mid sock -- } article type key [char] y = if article sock post endif ; defer posting-absent ' report is posting-absent : stat-repost-message { d: article sock -- } article s\" \nMessage-ID: " get-field { d: mid } s" STAT " sock write-file throw mid sock write-line throw sock read-status if article mid sock posting-absent endif ; : process-articles { d: articles sock -- } \ articles is at the start of an article articles begin split-article while ( 2rest 2article ) 2dup news-header? if 2dup sock stat-repost-message endif 2drop repeat 2drop 2drop ; : repost parse-name { d: user } parse-name { d: passwd } parse-name { d: server } parse-name { d: start-id } server nntp open-socket { sock } sock read-status throw s" AUTHINFO USER " sock write-file throw user sock write-line throw sock read-status throw s" AUTHINFO PASS " sock write-file throw passwd sock write-line throw sock read-status throw start-id articles start-articles sock process-articles s" QUIT" sock write-line throw sock read-status throw sock close-file throw ;