r773 - ofw/inet

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
 \