[OpenBIOS] r773 - ofw/inet
svn at openbios.org
svn at openbios.org
Sun Jan 6 00:48:04 CET 2008
Author: wmb
Date: 2008-01-06 00:48:04 +0100 (Sun, 06 Jan 2008)
New Revision: 773
Modified:
ofw/inet/pop3.fth
Log:
UI improvements in the POP3 demonstration code (not used by most builds).
Modified: ofw/inet/pop3.fth
===================================================================
--- ofw/inet/pop3.fth 2008-01-05 23:45:20 UTC (rev 772)
+++ ofw/inet/pop3.fth 2008-01-05 23:48:04 UTC (rev 773)
@@ -33,13 +33,24 @@
: send-one ( $ -- ok? ) >mail-buffer " +OK" send ( ok? ) ;
: send-two ( $2 $1 -- ok? ) >mail-buffer mail-append " +OK" send ( ok? ) ;
-: send-user-name ( -- ok? )
- " pop-user" $getenv drop ( adr len )
- " USER " send-two ( ok? )
+: get-password ( -- adr len )
+ pad 0
+ begin ( adr len )
+ key case
+ carret of exit then
+ bs of 1- 0 max 2dup + 0 swap c! then
+
+ \ default ( adr len char )
+ over d# 32 >= abort" Password too long" ( adr len char )
+ 3dup -rot + c! ( adr len char )
+ swap 1+ swap ( adr len' char )
+ endcase ( adr len )
+ again
;
: send-password ( -- ok? )
- " pop-password" $getenv drop ( adr len )
- " PASS " send-two ( ok? )
+ ." Password: " get-password ( adr len )
+ 2dup " PASS " send-two ( adr len ok? )
+ -rot erase \ Don't leak password ( ok? )
;
: number? ( b -- ascii? )
@@ -73,12 +84,12 @@
while
d# 10 *
pop3-buf tbuf-ptr + c@ h# 0f and +
- +pop3-buf
+ +tbuf
repeat ( # )
;
: get-num ( -- )
- 0 to pop3-buf-ptr
+ 0 to tbuf-ptr
begin
begin key? until
key dup emit ( key )
@@ -166,61 +177,36 @@
quit-mail drop
;
-: rmail ( -- )
+: open-rmail-connection ( server$ -- )
+ debug-mail? if ." Opening TCP stack..." cr then ( server$ )
- false
+ " tcp" open-dev to tcp-ih ( server$ )
+ tcp-ih 0= abort" Failed to open tcp stack!" ( server$ )
- " pop-server" $getenv if
- cr
- ." Missing pop-server environment variable" cr
- ." Use ""$setenv"" to set the pop-server name:" cr
- ." "" <servername>"" "" pop-server"" $setenv" cr
- drop true
- else 2drop then
-
- " pop-user" $getenv if
- cr
- ." Missing pop-user environment variable" cr
- ." Use ""$setenv"" to set the pop-user name:" cr
- ." "" <username>"" "" pop-user"" $setenv" cr
- drop true
- else 2drop then
-
- " pop-password" $getenv if
- cr
- ." Missing pop-password environment variable" cr
- ." Use ""$setenv"" to set the pop-password name:" cr
- ." "" <password>"" "" pop-password"" $setenv" cr
- drop true
- else 2drop then
-
- if exit then
-
- debug-mail? if ." Opening TCP stack..." cr then
-
- " tcp" open-dev to tcp-ih
- tcp-ih 0= if ." Failed to open tcp stack!" exit then
-
- allocate-mail-buffer
+ allocate-mail-buffer ( server$ )
- " pop-server" $getenv drop open-pop3-connection 0= if
- close-pop3 exit
+ open-pop3-connection 0= if ( )
+ ." Can't connect to POP3 server"
+ close-pop3 abort
then
debug-mail? if ." Connection established" cr then
verify-pop3 0= if
debug-mail? if ." Connection did not verify" cr then
- close-pop3 exit
+ close-pop3 abort
then
+;
+: authenticate-rmail ( user$ -- )
debug-mail? if ." Sending USER name..." cr then
- send-user-name if
+
+ " USER " send-two if
debug-mail? if ." USER accepted" cr then
else
debug-mail? if ." Bad USER" cr then
close-pop3
- exit
+ abort
then
debug-mail? if ." Sending password..." cr then
@@ -229,9 +215,14 @@
else
debug-mail? if ." Bad Password" cr then
close-pop3
- exit
+ abort
then
+;
+: (rmail) ( user$ server$ -- )
+ open-rmail-connection ( user$ )
+ authenticate-rmail ( )
+
debug-mail? if ." Getting status..." cr then
0 to #messages
get-status if
@@ -247,17 +238,10 @@
close-pop3
;
-: (show-pop3) ( adr len -- )
- 2dup $getenv if missing-var else
- 2swap type ." : " type cr
- then
+: rmail ( "server" "user" -- )
+ safe-parse-word safe-parse-word 2swap (rmail)
;
-: show-pop3 ( -- )
- " pop-server" (show-pop3)
- " pop-user" (show-pop3)
- " pop-password" (show-pop3)
-;
\ LICENSE_BEGIN
\ Copyright (c) 2006 FirmWorks
\
More information about the OpenBIOS
mailing list