S" agents/pop3rules/wcmatch.f" INCLUDED
2 VALUE TOP-NUM
0 VALUE MSG-SIZE
WARNING 0!

VARIABLE max-msg-size
VARIABLE POP3ms     \ filename of max mail sizes
VARIABLE POP3fltr   \ filename of filter file
VARIABLE POP3Delbig \ flag, delete big messages
VARIABLE POP3fltr-list  \ list of filter
VARIABLE tm?        \ time is fit?
VARIABLE POP3hdr        \ address of header
VARIABLE POP3max-num    \ max num of messages
0 VALUE POP3#msg


: DoList ( xt list -- ) 
    SWAP >R BEGIN @ ?DUP WHILE  DUP R@ EXECUTE  REPEAT  RDROP ;
: NodeValue CELL+ @ ;
: FreeList ( list -- )
    DUP @  BEGIN  DUP  WHILE  DUP @ SWAP FREE THROW  REPEAT SWAP ! ;
: AddNode ( value list -- )
    2 CELLS ALLOCATE THROW >R
    SWAP R@ CELL+ !  DUP @ R@ !  R> SWAP ! ;
: AppendNode ( node list -- )
    BEGIN DUP @ ?DUP WHILE NIP REPEAT  AddNode ;

0 
1 CELLS -- fltr-typ
1 CELLS -- fltr-val
CONSTANT /fltr-node

2 CELLS CONSTANT m-size
: m-a ( i -- a) m-size * POP3listb @ + ;
: m@ ( i -- size n) m-a 2@ ;
: m! ( size n i --) m-a 2! ;
: m-swap ( i j ) DUP m@ 2OVER SWAP m@ ROT m! ROT DROP ROT m! ;
: m-cmp ( i j ) m@ DROP SWAP m@ DROP SWAP - ;
0 VALUE i-m-min
: sort-msgs
    TotalMessages @ 0
    ?DO
      I TO i-m-min
      TotalMessages @ I 1+
      ?DO
        i-m-min I m-cmp 0 >
        IF I TO i-m-min THEN
      LOOP
      i-m-min I <>
      IF
        I i-m-min m-swap
      THEN
    LOOP
;
: list-msgs
    TotalMessages @ 0
    ?DO
        I m@ . 2 / . CR
    LOOP
;

: A-HHMM ( addr u -- hh mm )
  0 0 2SWAP >NUMBER 2>R D>S ( hh )
  0 0 2R> 1- 0 MAX SWAP 1+ SWAP >NUMBER 2DROP D>S ( mm )
;


0
2 -- wYear
2 -- wMonth
2 -- wDayOfWeek
2 -- wDay
2 -- wHour
2 -- wMinute
2 -- wSecond
2 -- wMilliseconds
CONSTANT /SYSTEMTIME
CREATE SYSTEMTIME /SYSTEMTIME ALLOT

WINAPI: GetLocalTime KERNEL32.DLL

: hhmm
  SYSTEMTIME GetLocalTime DROP
  SYSTEMTIME wMinute W@
  SYSTEMTIME wHour W@ 60 * + ;

: WITHIN ( n1|u1 n2|u2 n3|u3 -- flag )
  OVER - >R - R> U<
;
255 CONSTANT MAXCOUNTED

: "CLIP"  ( a1 n1 -- a1 n1 )  MAXCOUNTED MIN 0 MAX ;
: PLACE   ( addr len dest -- )
    SWAP "CLIP" SWAP    2DUP 2>R    CHAR+ SWAP MOVE 2R> C! ;
: C+! ( N A -- )   DUP C@ ROT + SWAP C! ;
: +PLACE        ( addr len dest -- ) \ append string addr,len to counted
    >R "CLIP" MAXCOUNTED R@ C@ - MIN R>
    2DUP 2>R    COUNT CHARS + SWAP MOVE 2R> C+! ;
: +PLACE0 ( A -- ) COUNT + 0 SWAP C! ;
: ZPLACE ( a u buf -- )   SWAP 2DUP + 0 SWAP C! CMOVE ;    
: +ZPLACE ( a u buf -- )  ASCIIZ> + ZPLACE ;    
: S>ZALLOC ( a u -- a1)   DUP 1+ ALLOCATE THROW >R  R@ ZPLACE  R> ;


: TimeInterval: ( -- flag )
  hhmm
  BL SKIP 
  [CHAR] - PARSE A-HHMM SWAP 60 * +
  BL PARSE A-HHMM SWAP 60 * + 1+ WITHIN
;

: Time:  TimeInterval: tm? ! ;

: add-fltr ( typ -- )
    tm? @
    IF
        /fltr-node ALLOCATE THROW >R
        R@ fltr-typ !
        BL SKIP 1 PARSE S>ZALLOC R@ fltr-val !
        R> POP3fltr-list AppendNode
    ELSE
        DROP 1 PARSE 2DROP
    THEN
;    

: retr: 1 add-fltr ;
: keep: 2 add-fltr ;
: dele: 3 add-fltr ;


: ti: ( size --)
    TimeInterval: 
    IF  max-msg-size ! 
    ELSE DROP THEN ;

: <ti> \ time-interval size ( -- )
    TimeInterval: 1 WORD SWAP
    IF 
        0 0 ROT COUNT >NUMBER 2DROP D>S max-msg-size !
    ELSE
        DROP
    THEN
;

: (include) ( xt a -- )
    @ ?DUP
    IF
       SWAP TO <PRE>
       ." Including " 
       ASCIIZ> 2DUP TYPE CR
       ['] INCLUDED CATCH ?DUP
       IF
          >R
          2DROP ." Including file ERROR: " R> . ." line " CURSTR @ . CR
       THEN 
       ['] NOOP TO <PRE>
    ELSE
        DROP
    THEN
;

: include-ms   ['] <ti>   POP3ms   (include) ;
: include-fltr 
    -1 tm? !
    ['] NOOP POP3fltr (include) ;
: -ms BL WORD COUNT 2DUP TYPE CR S>ZALLOC POP3ms ! ;
: -delbig TRUE POP3Delbig ! ;
: -fltr BL WORD COUNT S>ZALLOC POP3fltr ! ;

: permitted-size? ( size -- ?)
    2 /
    max-msg-size @ ?DUP
    IF
        <
    ELSE
        DROP TRUE
    THEN
;

: POP3DELE ( n --)
    >R
    POP3delete @
    IF <#CRLF 2DROP R@ 0 #S S" DELE " HOLDS #> POP3write
        POP3replyERR DROP
    THEN
    RDROP
;

: POP3recvmsg1 ( n -- )
  >R
  POP3envelope @ IF R@ POP3messagesSeparator THEN
  <#CRLF 2DROP R@ 0 #S S" RETR " HOLDS #> POP3write
\  TotalMessages @ 0 <# 0 HOLD #S S"  from " HOLDS 2DROP R@ 0 #S S" POP3RECV: message " HOLDS #> AgentTitle
  POP3replyERR IF R> DROP EXIT THEN
  BEGIN
    POP3line
    SOURCE S" ." COMPARE 0=
  UNTIL
  R> POP3DELE
  POP3uidl @ IF SaveReceivedID THEN
;

CREATE 'hdr-filename' 128 ALLOT
: hdr-filename ( -- c-addr)
    S" wwwroot/" 'hdr-filename' PLACE
    POP3server @ COUNT 'hdr-filename' +PLACE
    S" -" 'hdr-filename' +PLACE
    POP3user @ COUNT 'hdr-filename' +PLACE
    S" .txt" 'hdr-filename' +PLACE
    'hdr-filename' +PLACE0
    'hdr-filename'
; 

0 VALUE fhdr

WINAPI: DeleteFileA KERNEL32.DLL

: WRITE-HDR ( a u --)
    fhdr IF fhdr WRITE-LINE DROP
            ELSE 2DROP THEN ;
: HR   S" --------------------------------------------------------"
    WRITE-HDR ;
: ?OPEN-HDR ( -- )
    fhdr 0=
    IF
        hdr-filename 1+ DeleteFileA DROP
        hdr-filename COUNT W/O OPEN/CREATE-FILE 0=
        IF TO fhdr
            S" Реестр заголовков писем, лежащих на сервере."
            WRITE-HDR
            S" Время последнего соединения с сервером: "
            WRITE-HDR
            SYSTEMTIME GetLocalTime DROP
            <#  SYSTEMTIME wMinute W@ S>D # # [CHAR] : HOLD 2DROP
                SYSTEMTIME wHour W@ S>D # #        BL  HOLD 2DROP
                SYSTEMTIME wYear W@ S>D # # # # [CHAR] . HOLD 2DROP
                SYSTEMTIME wMonth W@ S>D # # [CHAR] . HOLD 2DROP
                SYSTEMTIME wDay  W@ S>D # # 
            #> WRITE-HDR
            HR
        ELSE DROP THEN
    THEN
;
: CLOSE-HDR
    fhdr
    IF
        S"  "  WRITE-HDR
        fhdr CLOSE-FILE DROP
    THEN
;

: POP3linehdr ( -- )
  POP3connection @ SocketReadLine #TIB ! TO TIB >IN 0!
  SOURCE POP3hdr @ +ZPLACE
  LT LTL @  POP3hdr @ +ZPLACE
\  SOURCE ToListbox
;

: POP3recvhdr ( # -- )
  >R 
  POP3hdr @ 0!
  <#CRLF 2DROP TOP-NUM S>D #S 2DROP
         BL HOLD R@ S>D #S
         S" TOP " HOLDS #> POP3write
  POP3replyERR IF R> DROP EXIT THEN
  BEGIN
    POP3linehdr
    SOURCE S" ." COMPARE 0=
\    SOURCE NIP 0=
  UNTIL
\  TOP-NUM 1+ 0 DO  POP3linehdr LOOP
  RDROP
;
: write-hdr
    ?OPEN-HDR
    <# MSG-SIZE 2 / S>D #S S" Размер сообщения:" HOLDS #> WRITE-HDR
    POP3hdr @ ASCIIZ> WRITE-HDR
    S"  " WRITE-HDR
    HR
;
: fit-message? ( az -- ?)
    DUP >R
    DUP C@ [CHAR] ~ = DUP >R IF 1+ THEN
    ASCIIZ> POP3hdr @ ASCIIZ> 2SWAP WC-MATCH
    R> IF 0= THEN
    DUP IF ." Filter node '" R@ ASCIIZ> TYPE ." ', " THEN
    RDROP
;

: (apply-fltr) ( # -- typ)
    POP3fltr-list @
    IF
        POP3recvhdr
        POP3fltr-list
        BEGIN @ ?DUP WHILE
          DUP NodeValue 
          DUP fltr-val @ fit-message?
          IF NIP fltr-typ @ EXIT THEN
          DROP
        REPEAT
    ELSE DROP THEN
    1
;
: sretr  S" RETR" ;
: skeep  S" KEEP" ;
: sdele  S" DELE" ;
CREATE (.action) ' sretr ,  ' skeep , ' sdele , 
: .action ( typ -- )  1- CELLS (.action) + @ EXECUTE TYPE ;

: apply-fltr ( # -- typ)
    (apply-fltr)
    DUP .action CR
;

CREATE what-to-do ' POP3recvmsg , ' DROP , ' POP3DELE , 
: ProcessMessage ( # -- )
    DUP apply-fltr 1- CELLS what-to-do + @ EXECUTE
;    

WINAPI: MessageBoxA USER32.DLL

: POP3recvmsgs1 ( -- )
  ." POP3RECV Filter patch. Nicholas Nemtsev. 2001. nemtsev@nncron.ru" CR
  include-ms
  include-fltr
  10240 ALLOCATE THROW POP3hdr !
  max-msg-size @ ?DUP
  IF ." Max message size is " . CR THEN
  sort-msgs
\  list-msgs
  ?OPEN-HDR
  POP3liste @ POP3listb @
  ?DO
    I @ TO POP3#msg
    POP3uidl @
    IF POP3#msg POP3_IsNewMessage 0=
       IF POP3#msg POP3DELE FALSE ELSE TRUE THEN
    ELSE TRUE THEN
    IF
       I CELL+ @ DUP TO MSG-SIZE permitted-size?
       IF 
           POP3#msg ProcessMessage
       ELSE
           POP3#msg POP3recvhdr write-hdr
           POP3Delbig @
           IF 
               POP3#msg POP3DELE 
               POP3uidl @ IF SaveReceivedID THEN
           THEN
       THEN
    THEN
    POP3max-num @ ?DUP 
        IF 1- DUP POP3max-num !
           0= IF LEAVE THEN THEN
  2 CELLS +LOOP
  CLOSE-HDR
;

: -mn  WORD: POP3max-num ! ;

HEX
: JMP ( addr-to addr-from -- )
  >R
  0E9 R@ C!
  R@ 1+ CELL+ - R> 1+ !
;
DECIMAL

' POP3recvmsgs1 ' POP3recvmsgs JMP
' POP3recvmsg1 ' POP3recvmsg JMP
