Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

smail

0 views
Skip to first unread message

Marcel Hendrix

unread,
Dec 16, 2002, 7:42:37 AM12/16/02
to
Using my [updated] minimal proposed pipes and sockets wordset
(http://home.iae.nl/users/mhx/pipes&socks.html), writing
a simple sendmail program can be trivial, as evidenced
by the 100-line program shown below.

Most words are explained in iForth FAQ at
http://home.iae.nl/users/mhx/i4faq.html, but here's a selection:

+CR -- append a hard <CR><LF> pair.
$+ -- add second string to first
<WORD> -- some Forths call this PARSE-WORD, a non-copying WORD
?FILE -- use THROW
.~ -- use ." and be creative with embedded '"'

Here is a dump with TRUE TO debug?

===
FORTH> in sendmail
Creating --- Socket interface Version 1.08 ---
Creating --- Sendmail Version 1.01 ---

Usage: SENDMAIL mailserv to_addr "subject" messagefile
Example: SENDMAIL smtp.IAEhv.nl m...@iae.nl "Send mail works!" file.txt
ok
FORTH> TRUE TO debug? ok
FORTH> cr sendmail smtp.IAEhv.nl m...@iae.nl "clf message" mymail
220 eowyn.vianetworks.nl ESMTP Postfix
HELO smtp.IAEhv.nl
250 eowyn.vianetworks.nl
MAIL FROM:m...@iae.nl
250 Ok
RCPT TO:m...@iae.nl
DATA
From: Marcel Hendrix <m...@iae.nl>
Subject: clf message
To: m...@iae.nl


250 Ok
354 End data with <CR><LF>.<CR><LF>
Using my [updated] minimal proposed pipes and sockets wordset
(http://home.iae.nl/users/mhx/pipes&socks.html), writing
a simple sendmail program can be trivial, as evidenced
by the 100-line program shown below.

-marcel

.
250 Ok: queued as 20E3F21117
QUIT
ok
===

-marcel

---
(*
* LANGUAGE : ANS Forth
* PROJECT : Forth Environments
* DESCRIPTION : Send e-mail to ISP
* CATEGORY : Utility
* AUTHOR : Marcel Hendrix
* LAST CHANGE : December 15, 2002, Marcel Hendrix
*)


NEEDS -miscutil
NEEDS -sockets

REVISION -sendmail "ÄÄÄ Sendmail Version 1.01 ÄÄÄ"

PRIVATES

DOC
(*
Demonstrates using socket API functions to perform email
transmission using the SMTP protocol. Takes four parameters, as
follows:

sendmail mailserver to_addr "subject" messagefile.txt

Connects to the specified mail server, uses to_addr (and an
internally preset from_addr) in the transmitted message header,
then sends real name (internal), subject, repeated To-field and
each line of the messagefile (text file) as the email message
body. Transfer is implemented using the SMTP Internet protocol.

The message data is prepended with some extra info to prevent
anti-spam software from dumping the mail immediately.
*)
ENDDOC

#25 =: IPPORT_SMTP PRIVATE -- SMTP standard port address

CREATE realname PRIVATE ," Marcel Hendrix"
CREATE msubject PRIVATE #256 CHARS ALLOT -- msg subject
CREATE mto PRIVATE #256 CHARS ALLOT -- to address
CREATE mfrom PRIVATE ," m...@iae.nl" -- from address
CREATE server PRIVATE #256 CHARS ALLOT -- {name | address in dotted notation} of the
-- server or host system we need to connect to
0 VALUE msocket PRIVATE
0 VALUE mfile PRIVATE

FALSE VALUE debug?

: .debug ( c-addr u -- )
debug? IF ?DUP IF TYPE ELSE DROP ENDIF
ELSE 2DROP
ENDIF ;P

: .data-header ( -- c-addr u )
S" From: " realname COUNT $+
S" <" $+ mfrom COUNT $+ S" >" $+ +CR
S" Subject: " $+ msubject COUNT $+ +CR
S" To: " $+ mto COUNT $+ +CR
S" " $+ +CR ;P

: mail-init ( "mailserver" "to" "from" "subject" "file" -- )
BL <WORD> server PACK DROP
BL <WORD> mto PACK DROP
&" <WORD> msubject PACK DROP
BL <WORD> R/O BIN OPEN-FILE ?FILE TO mfile
server COUNT IPPORT_SMTP OPEN-SERVICE TO msocket
msocket TRUE BLOCKING-MODE ( blocking for mail)
debug? IF #1000 ELSE 0 ENDIF SET-SOCKET-TIMEOUT
msocket PAD #4096 READ-SOCKET .debug ;P

: sline ( c-addr u -- )
+CR 2DUP .debug
msocket WRITE-SOCKET
msocket PAD #4096 READ-SOCKET .debug ;P

: helo-server ( -- ) S" HELO " server COUNT $+ sline ;P
: mail-from ( -- ) S" MAIL FROM:" mfrom COUNT $+ sline ;P
: rcpt-to ( -- ) S" RCPT TO:" mto COUNT $+ sline ;P
: data ( -- ) S" DATA" sline ;P
: send-quit ( -- ) S" QUIT" sline ;P
: mail-exit ( -- ) mfile CLOSE-FILE DROP msocket CLOSE-SOCKET ;P

: send-file ( -- )
.data-header sline
BEGIN PAD DUP #4096 mfile READ-LINE ?FILE 0<>
WHILE sline
REPEAT 2DROP
S" " +CR S" ." $+ sline ;P

: mail-loop ( -- ) helo-server mail-from rcpt-to data send-file send-quit ;P
: SENDMAIL ( "server" "to" "subject" "file" -- ) mail-init mail-loop mail-exit ;

:ABOUT CR .~ Usage: SENDMAIL mailserv to_addr "subject" messagefile~
CR .~ Example: SENDMAIL smtp.IAEhv.nl m...@iae.nl "Send mail works!" file.txt~ ;

.ABOUT -sendmail CR
DEPRIVE

(* End of Source *)


Michael L.Gassanenko

unread,
Dec 17, 2002, 1:07:03 AM12/17/02
to
Marcel Hendrix wrote:
> Most words are explained in iForth FAQ at
> http://home.iae.nl/users/mhx/i4faq.html, but here's a selection:
>

It seems, they are explained not there.

Marcel Hendrix

unread,
Dec 17, 2002, 1:54:15 PM12/17/02
to
(#33602) m...@iaehv.iae.nl (Marcel Hendrix) writes Re: smail

> Using my [updated] minimal proposed pipes and sockets wordset
> (http://home.iae.nl/users/mhx/pipes&socks.html), writing
> a simple sendmail program can be trivial, as evidenced
> by the 100-line program shown below.

Added two further examples, i.e. TELNET and POP3 clients.
TELNET is adapted from code by Jeffrey R. Fox. (The 'rey'
is significant, of course).

The POP3 code is the simplest, so I'll show it here.
I'm in for improvements.

-marcel

---
(*
* LANGUAGE : ANS Forth
* PROJECT : Forth Environments

* DESCRIPTION : Get e-mail using POP3


* CATEGORY : Utility
* AUTHOR : Marcel Hendrix

* LAST CHANGE : Tuesday, December 17, 2002 7:19 PM, Marcel Hendrix
*)

NEEDS -miscutil
NEEDS -sockets

REVISION -pop3 "ÄÄÄ POP3 Version 1.01 ÄÄÄ"

PRIVATES

DOC
(*
Use socket API functions to perform email transmission using POP3.

Connect to the (internally specified) POP3 server, using USER and PASS strings
(all internally preset).
*)
ENDDOC

#110 =: IPPORT_POP3 PRIVATE -- standard POP3 port address

CREATE username PRIVATE ," mhx"
CREATE passwd PRIVATE ," secret" -- it's not real.
CREATE server PRIVATE ," pop3.IAEhv.nl"
CREATE mailfile PRIVATE ," c:/dfwforth/examples/internet/pop3.dat"
CREATE eom$ PRIVATE 5 C, ^M C, ^J C, '.' C, ^M C, ^J C,

0 VALUE psocket PRIVATE
0 VALUE pfile PRIVATE
FALSE VALUE debug?

: .debug ( c-addr u -- )

debug? IF ?DUP IF CR TYPE ELSE DROP ENDIF
ELSE 2DROP
ENDIF ;P

: open-mailfile ( -- )
mailfile COUNT R/W BIN OPEN-FILE ?FILE TO pfile
pfile FILE-SIZE ?FILE ( move to eof )
pfile REPOSITION-FILE ?FILE ;P

: pop3-init ( -- )
open-mailfile
server COUNT IPPORT_POP3 OPEN-SERVICE TO psocket
psocket TRUE BLOCKING-MODE
#1000 SET-SOCKET-TIMEOUT
psocket PAD #4096 READ-SOCKET .debug ;P

: cmd? ( c-addr u -- true=error )
+CR 2DUP .debug
psocket WRITE-SOCKET
psocket PAD 3 READ-SOCKET S" +OK" COMPARE ;P

: sline? ( c-addr u -- c-addr u true=error )
cmd? >S
psocket PAD 3 + #4093 READ-SOCKET
NIP PAD SWAP 2DUP .debug S> ;P

: authorization ( -- )
S" USER " username COUNT $+ sline? ABORT" USER :: unknown" 2DROP
S" PASS " passwd COUNT $+ sline? ABORT" PASS :: refused" 2DROP ;P

: transaction ( -- #emails )
S" STAT" sline? ABORT" STAT :: refused"
4 /STRING ( cut off "+OK " )
BL SPLIT-AT-CHAR 2DROP ( select first argstring )
BASE @ >S DECIMAL NUMBER? S> BASE !
1 <> ABORT" STAT :: invalid number of e-mails" ;P

: pop3-quit ( -- ) S" QUIT" sline? 3DROP ;P
: pop3-exit ( -- ) pfile CLOSE-FILE DROP psocket CLOSE-SOCKET ;P

: .emails ( u -- )
CR ." You have " DUP DEC. ." e-mail" ?s ." waiting." ;P

: store-emails ( u -- )
0 ?DO
S" RETR " I 1+ (0DEC.R) $+ cmd? ABORT" RETR :: refused"
0 SET-SOCKET-TIMEOUT
BEGIN
psocket PAD #4096 READ-SOCKET 2DUP .debug
2DUP pfile WRITE-FILE ?FILE
eom$ COUNT SEARCH 2NIPS 0=
UNTIL
#1000 SET-SOCKET-TIMEOUT
S" DELE " I 1+ (0DEC.R) $+ cmd? ABORT" DELE :: refused"
LOOP ;P

: pop3-loop ( xt -- ) >S authorization transaction S> EXECUTE pop3-quit ;P
: POP3 ( -- ) pop3-init ['] store-emails pop3-loop pop3-exit ;
: .MAIL ( -- ) pop3-init ['] .emails pop3-loop pop3-exit ;

:ABOUT CR ." Usage: POP3 -- get the mail to " mailfile .$
CR ." .MAIL ( -- ) -- just tests if there's mail." ;

.ABOUT -pop3 CR

Marcel Hendrix

unread,
Dec 17, 2002, 9:14:57 PM12/17/02
to
(#33625) m...@iaehv.iae.nl (Marcel Hendrix) writes Re: smail

>> Using my [updated] minimal proposed pipes and sockets wordset
>> (http://home.iae.nl/users/mhx/pipes&socks.html), writing
>> a simple sendmail program can be trivial, as evidenced
>> by the 100-line program shown below.

Here is a absolutely minimal newsreader (only clf, uses
a standard text editor for browsing, can't post yet).

A ridiculously fat 144 lines.

-marcel
---
(*
* LANGUAGE : ANS Forth
* PROJECT : Forth Environments

* DESCRIPTION : Get news using NNTP


* CATEGORY : Utility
* AUTHOR : Marcel Hendrix

* LAST CHANGE : Wednesday, December 18, 2002 3:04 AM, Marcel Hendrix
*)

NEEDS -miscutil
NEEDS -sockets

REVISION -news "ÄÄÄ News with NNTP Version 1.00 ÄÄÄ"

PRIVATES

DOC
(*
Use socket API functions to perform news acquisition using NNTP.
Connect to an (internally specified) NNTP server.
*)
ENDDOC

#119 =: IPPORT_NNTP PRIVATE -- standard NNTP port address
CREATE server PRIVATE ," news.IAEhv.nl"
CREATE newsfile PRIVATE ," /dfwforth/examples/internet/news.dat"


CREATE eom$ PRIVATE 5 C, ^M C, ^J C, '.' C, ^M C, ^J C,

CREATE newsmarker PRIVATE 0 ,

0 VALUE nsocket PRIVATE
0 VALUE nfile PRIVATE

FALSE VALUE debug?

-- This will eventually grow into a .newsrc file --------------

: get^ ( -- u )
S" lastnews.dat" R/W BIN OPEN-FILE ?FILE >S
newsmarker 4 S READ-FILE ?FILE DROP S> CLOSE-FILE DROP
newsmarker @ ;P

: put^ ( u -- )
S" lastnews.dat" R/W BIN CREATE-FILE ?FILE >S
newsmarker !
newsmarker 4 S WRITE-FILE ?FILE S> CLOSE-FILE DROP ;P

-- ------------------------------------------------------------

: .debug ( c-addr u -- ) DUP debug? AND IF CR TYPE EXIT ENDIF 2DROP ;P

: open-newsfile ( -- )
newsfile COUNT R/W BIN OPEN-FILE ?FILE TO nfile
nfile FILE-SIZE ?FILE ( move to eof )
nfile REPOSITION-FILE ?FILE ;P

: nntp-init ( -- )
open-newsfile
server COUNT IPPORT_NNTP OPEN-SERVICE TO nsocket
nsocket TRUE BLOCKING-MODE
#1000 SET-SOCKET-TIMEOUT
nsocket PAD #255 READ-SOCKET .debug ;P

: cmd? ( c-addr u -- TRUE=error )
+CR 2DUP .debug
nsocket WRITE-SOCKET
nsocket PAD 3 READ-SOCKET DROP C@ '3' > ;P

: sline? ( c-addr u -- c-addr u TRUE=error )
cmd? >S
nsocket PAD 3 + #4093 READ-SOCKET

NIP PAD SWAP 2DUP .debug S> ;P

: $>NUM ( c-addr1 u1 -- c-addr2 u2 u3 )
BL SKIP BL SPLIT-AT-CHAR 2SWAP

BASE @ >S DECIMAL NUMBER? S> BASE !

1 <> IF CR ." $>num :: invalid number" 0 EXIT ENDIF ;P

: fetch ( c-addr u -- first last #num )
1 1 0 LOCALS| #articles first-article last-article |
S" GROUP " 2SWAP $+ sline? IF CR ." GROUP :: refused." EXIT ENDIF
$>NUM DROP ( cut off "2xx " )
$>NUM TO #articles
$>NUM TO first-article
$>NUM TO last-article 2DROP
CR #articles DEC. ." articles, from "
first-article DEC.
." to " last-article DEC.
first-article get^ MAX
last-article 2DUP SWAP - 1+ ;P

: separator ( -- )
$CR COUNT S" ---------------*----------------- " $+
S" NEXT ARTICLE ---------------*----------------- " $+
+CR +CR nfile WRITE-FILE ?FILE ;P

: ?store-it ( bool -- )
?EXIT
separator
0 SET-SOCKET-TIMEOUT
BEGIN
nsocket PAD #4096 READ-SOCKET 2DUP .debug
2DUP nfile WRITE-FILE ?FILE
eom$ COUNT SEARCH 2NIPS
UNTIL
#1000 SET-SOCKET-TIMEOUT ;P

: ask-for-it? ( u -- f )
S" ARTICLE " ROT (0DEC.R) $+ cmd?
DUP IF S" ARTICLE :: refused" .debug ENDIF ;P

: store-group ( c-addr u -- )
2DUP fetch ( -- c-addr u first last #num )
0= IF 2DROP CR ." No new news in " TYPE EXIT ENDIF
DUP >S ( save last )
1+ SWAP ?DO I ask-for-it? ?store-it LOOP 2DROP
S> 1+ put^ ;P

: store-news ( -- ) S" comp.lang.forth" store-group ;P
: nntp-quit ( -- ) S" QUIT" sline? 3DROP ;P
: nntp-exit ( -- ) nfile CLOSE-FILE DROP nsocket CLOSE-SOCKET ;P

: NEWS ( -- ) nntp-init store-news nntp-quit nntp-exit ;

:ABOUT CR ." Usage: NEWS -- get news to " newsfile .$ ;

.ABOUT -news CR

0 new messages