unofficial mirror of guile-user@gnu.org 
 help / color / mirror / Atom feed
* IMAP SSL Connection using Guile
@ 2017-04-30 16:42 Amirouche
  2017-05-02 11:58 ` Ludovic Courtès
  2017-05-02 19:47 ` Andy Wingo
  0 siblings, 2 replies; 4+ messages in thread
From: Amirouche @ 2017-04-30 16:42 UTC (permalink / raw)
  To: gnutls-help, guile-user@gnu.org

Héllo


I am trying to connect to an imap server using SSL but it fails. The 
program does
indeed connect to the remote server, but when I try to read on the port 
it blocks
until the connection is closed by the remote host.

Everything works fine using gnutls-cli.

The version reported by gnutls-cli is 3.5.8

Here is my code:

--------->8--------->8--------->8--------->8--------->8--------->8--------->8---------

(define-module (imap))

(use-modules (gnutls))
(use-modules (ice-9 rdelim))

(set-log-level! 10)
(set-log-procedure! pk)

(define tls-wrap (@@ (web client) tls-wrap))

(define (connect-to-server host port)
   (let ((addrinfo (car (getaddrinfo host (number->string port)))))
     (let ((port (socket (addrinfo:fam addrinfo)
                         SOCK_STREAM
                         IPPROTO_IP)))
       ;; Disable Nagle's algorithm.  We buffer ourselves.
       (setsockopt port IPPROTO_TCP TCP_NODELAY 1)
       (setvbuf port 'block 1024)
       (connect port (addrinfo:addr addrinfo))
       port)))

(define (make-imap-port host port)
   (let ((port (connect-to-server host port)))
     (tls-wrap port host)))

(define port (make-imap-port "imap.gmail.com" 993))

(pk 'out (read-line port))

--------->8--------->8--------->8--------->8--------->8--------->8--------->8--------->8---------

Here is the definition of tls-wrap in guile 2.2:

--------->8--------->8--------->8--------->8--------->8--------->8--------->8--------->8---------

(define (tls-wrap port server)
   "Return PORT wrapped in a TLS connection to SERVER.  SERVER must be a DNS
host name without trailing dot."
   (define (log level str)
     (format (current-error-port)
             "gnutls: [~a|~a] ~a" (getpid) level str))

   (ensure-gnutls)

   (let ((session (make-session connection-end/client)))
     ;; Some servers such as 'cloud.github.com' require the client to 
support
     ;; the 'SERVER NAME' extension.  However, 'set-session-server-name!' is
     ;; not available in older GnuTLS releases.  See
     ;; <http://bugs.gnu.org/18526> for details.
     (if (module-defined? (force gnutls-module)
                          'set-session-server-name!)
         (set-session-server-name! session server-name-type/dns server)
         (format (current-error-port)
                 "warning: TLS 'SERVER NAME' extension not supported~%"))

     (set-session-transport-fd! session (fileno port))
     (set-session-default-priority! session)

     ;; The "%COMPAT" bit allows us to work around firewall issues (info
     ;; "(gnutls) Priority Strings"); see <http://bugs.gnu.org/23311>.
     ;; Explicitly disable SSLv3, which is insecure:
     ;; <https://tools.ietf.org/html/rfc7568>.
     (set-session-priorities! session "NORMAL:%COMPAT:-VERS-SSL3.0")

     (set-session-credentials! session (make-certificate-credentials))

     ;; Uncomment the following lines in case of debugging emergency.
     ;;(set-log-level! 10)
     ;;(set-log-procedure! log)

     (handshake session)
     (let ((record (session-record-port session)))
       (define (read! bv start count)
         (define read-bv (get-bytevector-n record count))
         (if (eof-object? read-bv)
             0  ; read! returns 0 on eof-object
             (let ((read-bv-len (bytevector-length read-bv)))
               (bytevector-copy! read-bv 0 bv start read-bv-len)
               read-bv-len)))
       (define (write! bv start count)
         (put-bytevector record bv start count)
         count)
       (define (get-position)
         (rnrs-ports:port-position record))
       (define (set-position! new-position)
         (rnrs-ports:set-port-position! record new-position))
       (define (close)
         (unless (port-closed? port)
           (close-port port))
         (unless (port-closed? record)
           (close-port record)))
       (make-custom-binary-input/output-port "gnutls wrapped port" read! 
write!
                                             get-position set-position!
                                             close))))

--------->8--------->8--------->8--------->8--------->8--------->8--------->8--------->8---------

At last, here is the debug output I have:

--------->8--------->8--------->8--------->8--------->8--------->8--------->8--------->8---------

;;; (5 "REC[0x1bcef00]: Allocating epoch #0\n")

;;; (3 "ASSERT: constate.c[_gnutls_epoch_get]:600\n")

;;; (5 "REC[0x1bcef00]: Allocating epoch #1\n")

;;; (4 "HSK[0x1bcef00]: Adv. version: 3.3\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_ECDHE_ECDSA_AES_256_GCM_SHA384 (C0.2C)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_ECDHE_ECDSA_CAMELLIA_256_GCM_SHA384 (C0.87)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_ECDHE_ECDSA_CHACHA20_POLY1305 (CC.A9)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_ECDHE_ECDSA_AES_256_CCM (C0.AD)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_ECDHE_ECDSA_AES_256_CBC_SHA1 (C0.0A)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_ECDHE_ECDSA_AES_256_CBC_SHA384 (C0.24)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_ECDHE_ECDSA_CAMELLIA_256_CBC_SHA384 (C0.73)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_ECDHE_ECDSA_AES_128_GCM_SHA256 (C0.2B)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_ECDHE_ECDSA_CAMELLIA_128_GCM_SHA256 (C0.86)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_ECDHE_ECDSA_AES_128_CCM (C0.AC)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_ECDHE_ECDSA_AES_128_CBC_SHA1 (C0.09)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_ECDHE_ECDSA_AES_128_CBC_SHA256 (C0.23)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_ECDHE_ECDSA_CAMELLIA_128_CBC_SHA256 (C0.72)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_ECDHE_ECDSA_3DES_EDE_CBC_SHA1 (C0.08)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_ECDHE_RSA_AES_256_GCM_SHA384 (C0.30)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_ECDHE_RSA_CAMELLIA_256_GCM_SHA384 (C0.8B)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_ECDHE_RSA_CHACHA20_POLY1305 (CC.A8)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_ECDHE_RSA_AES_256_CBC_SHA1 (C0.14)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_ECDHE_RSA_AES_256_CBC_SHA384 (C0.28)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_ECDHE_RSA_CAMELLIA_256_CBC_SHA384 (C0.77)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_ECDHE_RSA_AES_128_GCM_SHA256 (C0.2F)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_ECDHE_RSA_CAMELLIA_128_GCM_SHA256 (C0.8A)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_ECDHE_RSA_AES_128_CBC_SHA1 (C0.13)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_ECDHE_RSA_AES_128_CBC_SHA256 (C0.27)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_ECDHE_RSA_CAMELLIA_128_CBC_SHA256 (C0.76)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_ECDHE_RSA_3DES_EDE_CBC_SHA1 (C0.12)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_RSA_AES_256_GCM_SHA384 (00.9D)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_RSA_CAMELLIA_256_GCM_SHA384 (C0.7B)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: GNUTLS_RSA_AES_256_CCM 
(C0.9D)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: GNUTLS_RSA_AES_256_CBC_SHA1 
(00.35)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_RSA_AES_256_CBC_SHA256 (00.3D)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_RSA_CAMELLIA_256_CBC_SHA1 (00.84)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_RSA_CAMELLIA_256_CBC_SHA256 (00.C0)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_RSA_AES_128_GCM_SHA256 (00.9C)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_RSA_CAMELLIA_128_GCM_SHA256 (C0.7A)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: GNUTLS_RSA_AES_128_CCM 
(C0.9C)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: GNUTLS_RSA_AES_128_CBC_SHA1 
(00.2F)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_RSA_AES_128_CBC_SHA256 (00.3C)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_RSA_CAMELLIA_128_CBC_SHA1 (00.41)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_RSA_CAMELLIA_128_CBC_SHA256 (00.BA)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_RSA_3DES_EDE_CBC_SHA1 (00.0A)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_DHE_RSA_AES_256_GCM_SHA384 (00.9F)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_DHE_RSA_CAMELLIA_256_GCM_SHA384 (C0.7D)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_DHE_RSA_CHACHA20_POLY1305 (CC.AA)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: GNUTLS_DHE_RSA_AES_256_CCM 
(C0.9F)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_DHE_RSA_AES_256_CBC_SHA1 (00.39)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_DHE_RSA_AES_256_CBC_SHA256 (00.6B)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_DHE_RSA_CAMELLIA_256_CBC_SHA1 (00.88)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_DHE_RSA_CAMELLIA_256_CBC_SHA256 (00.C4)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_DHE_RSA_AES_128_GCM_SHA256 (00.9E)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_DHE_RSA_CAMELLIA_128_GCM_SHA256 (C0.7C)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: GNUTLS_DHE_RSA_AES_128_CCM 
(C0.9E)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_DHE_RSA_AES_128_CBC_SHA1 (00.33)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_DHE_RSA_AES_128_CBC_SHA256 (00.67)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_DHE_RSA_CAMELLIA_128_CBC_SHA1 (00.45)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_DHE_RSA_CAMELLIA_128_CBC_SHA256 (00.BE)\n")

;;; (4 "HSK[0x1bcef00]: Keeping ciphersuite: 
GNUTLS_DHE_RSA_3DES_EDE_CBC_SHA1 (00.16)\n")

;;; (4 "EXT[0x1bcef00]: Sending extension OCSP Status Request (5 bytes)\n")

;;; (2 "HSK[0x1bcef00]: sent server name: 'imap.gmail.com'\n")

;;; (4 "EXT[0x1bcef00]: Sending extension Server Name Indication (19 
bytes)\n")

;;; (4 "EXT[0x1bcef00]: Sending extension Safe Renegotiation (1 bytes)\n")

;;; (4 "EXT[0x1bcef00]: Sending extension Session Ticket (0 bytes)\n")

;;; (4 "EXT[0x1bcef00]: Sending extension Supported curves (12 bytes)\n")

;;; (4 "EXT[0x1bcef00]: Sending extension Supported ECC Point Formats (2 
bytes)\n")

;;; (4 "EXT[0x1bcef00]: sent signature algo (4.1) RSA-SHA256\n")

;;; (4 "EXT[0x1bcef00]: sent signature algo (4.3) ECDSA-SHA256\n")

;;; (4 "EXT[0x1bcef00]: sent signature algo (5.1) RSA-SHA384\n")

;;; (4 "EXT[0x1bcef00]: sent signature algo (5.3) ECDSA-SHA384\n")

;;; (4 "EXT[0x1bcef00]: sent signature algo (6.1) RSA-SHA512\n")

;;; (4 "EXT[0x1bcef00]: sent signature algo (6.3) ECDSA-SHA512\n")

;;; (4 "EXT[0x1bcef00]: sent signature algo (3.1) RSA-SHA224\n")

;;; (4 "EXT[0x1bcef00]: sent signature algo (3.3) ECDSA-SHA224\n")

;;; (4 "EXT[0x1bcef00]: sent signature algo (2.1) RSA-SHA1\n")

;;; (4 "EXT[0x1bcef00]: sent signature algo (2.3) ECDSA-SHA1\n")

;;; (4 "EXT[0x1bcef00]: Sending extension Signature Algorithms (22 
bytes)\n")

;;; (4 "HSK[0x1bcef00]: CLIENT HELLO was queued [248 bytes]\n")

;;; (5 "REC[0x1bcef00]: Preparing Packet Handshake(22) with length: 248 
and min pad: 0\n")

;;; (9 "ENC[0x1bcef00]: cipher: NULL, MAC: MAC-NULL, Epoch: 0\n")

;;; (5 "REC[0x1bcef00]: Sent Packet[1] Handshake(22) in epoch 0 and 
length: 253\n")

;;; (3 "ASSERT: buffers.c[get_last_packet]:1159\n")

;;; (10 "READ: Got 5 bytes from 0x7\n")

;;; (10 "READ: read 5 bytes from 0x7\n")

;;; (10 "RB: Have 0 bytes into buffer. Adding 5 bytes.\n")

;;; (10 "RB: Requested 5 bytes\n")

;;; (5 "REC[0x1bcef00]: SSL 3.3 Handshake packet received. Epoch 0, 
length: 59\n")

;;; (5 "REC[0x1bcef00]: Expected Packet Handshake(22)\n")

;;; (5 "REC[0x1bcef00]: Received Packet Handshake(22) with length: 59\n")

;;; (10 "READ: Got 59 bytes from 0x7\n")

;;; (10 "READ: read 59 bytes from 0x7\n")

;;; (10 "RB: Have 5 bytes into buffer. Adding 59 bytes.\n")

;;; (10 "RB: Requested 64 bytes\n")

;;; (5 "REC[0x1bcef00]: Decrypted Packet[0] Handshake(22) with length: 
59\n")

;;; (4 "HSK[0x1bcef00]: SERVER HELLO (2) was received. Length 55[55], 
frag offset 0, frag length: 55, sequence: 0\n")

;;; (4 "HSK[0x1bcef00]: Server's version: 3.3\n")

;;; (4 "HSK[0x1bcef00]: SessionID length: 0\n")

;;; (4 "HSK[0x1bcef00]: SessionID: cc\n")

;;; (4 "HSK[0x1bcef00]: Selected cipher suite: 
ECDHE_RSA_CHACHA20_POLY1305\n")

;;; (4 "HSK[0x1bcef00]: Selected compression method: NULL (0)\n")

;;; (4 "EXT[0x1bcef00]: Parsing extension 'Safe Renegotiation/65281' (1 
bytes)\n")

;;; (4 "EXT[0x1bcef00]: Parsing extension 'Session Ticket/35' (0 bytes)\n")

;;; (4 "EXT[0x1bcef00]: Parsing extension 'Supported ECC Point 
Formats/11' (2 bytes)\n")

;;; (4 "HSK[0x1bcef00]: Safe renegotiation succeeded\n")

;;; (3 "ASSERT: buffers.c[get_last_packet]:1159\n")

;;; (10 "READ: Got 5 bytes from 0x7\n")

;;; (10 "READ: read 5 bytes from 0x7\n")

;;; (10 "RB: Have 0 bytes into buffer. Adding 5 bytes.\n")

;;; (10 "RB: Requested 5 bytes\n")

;;; (5 "REC[0x1bcef00]: SSL 3.3 Handshake packet received. Epoch 0, 
length: 3081\n")

;;; (5 "REC[0x1bcef00]: Expected Packet Handshake(22)\n")

;;; (5 "REC[0x1bcef00]: Received Packet Handshake(22) with length: 3081\n")

;;; (10 "READ: Got 1139 bytes from 0x7\n")

;;; (10 "READ: Got 1208 bytes from 0x7\n")

;;; (10 "READ: Got 734 bytes from 0x7\n")

;;; (10 "READ: read 3081 bytes from 0x7\n")

;;; (10 "RB: Have 5 bytes into buffer. Adding 3081 bytes.\n")

;;; (10 "RB: Requested 3086 bytes\n")

;;; (5 "REC[0x1bcef00]: Decrypted Packet[1] Handshake(22) with length: 
3081\n")

;;; (4 "HSK[0x1bcef00]: CERTIFICATE (11) was received. Length 
3077[3077], frag offset 0, frag length: 3077, sequence: 0\n")

;;; (3 "ASSERT: extensions.c[_gnutls_get_extension]:65\n")

;;; (3 "ASSERT: buffers.c[get_last_packet]:1159\n")

;;; (10 "READ: Got 5 bytes from 0x7\n")

;;; (10 "READ: read 5 bytes from 0x7\n")

;;; (10 "RB: Have 0 bytes into buffer. Adding 5 bytes.\n")

;;; (10 "RB: Requested 5 bytes\n")

;;; (5 "REC[0x1bcef00]: SSL 3.3 Handshake packet received. Epoch 0, 
length: 333\n")

;;; (5 "REC[0x1bcef00]: Expected Packet Handshake(22)\n")

;;; (5 "REC[0x1bcef00]: Received Packet Handshake(22) with length: 333\n")

;;; (10 "READ: Got 333 bytes from 0x7\n")

;;; (10 "READ: read 333 bytes from 0x7\n")

;;; (10 "RB: Have 5 bytes into buffer. Adding 333 bytes.\n")

;;; (10 "RB: Requested 338 bytes\n")

;;; (5 "REC[0x1bcef00]: Decrypted Packet[2] Handshake(22) with length: 
333\n")

;;; (4 "HSK[0x1bcef00]: SERVER KEY EXCHANGE (12) was received. Length 
329[329], frag offset 0, frag length: 329, sequence: 0\n")

;;; (2 "received curve SECP256R1\n")

;;; (4 "HSK[0x1bcef00]: Selected ECC curve SECP256R1 (2)\n")

;;; (3 "ASSERT: extensions.c[_gnutls_get_extension]:65\n")

;;; (4 "HSK[0x1bcef00]: verify handshake data: using RSA-SHA256\n")

;;; (3 "ASSERT: buffers.c[get_last_packet]:1159\n")

;;; (10 "READ: Got 5 bytes from 0x7\n")

;;; (10 "READ: read 5 bytes from 0x7\n")

;;; (10 "RB: Have 0 bytes into buffer. Adding 5 bytes.\n")

;;; (10 "RB: Requested 5 bytes\n")

;;; (5 "REC[0x1bcef00]: SSL 3.3 Handshake packet received. Epoch 0, 
length: 4\n")

;;; (5 "REC[0x1bcef00]: Expected Packet Handshake(22)\n")

;;; (5 "REC[0x1bcef00]: Received Packet Handshake(22) with length: 4\n")

;;; (10 "READ: Got 4 bytes from 0x7\n")

;;; (10 "READ: read 4 bytes from 0x7\n")

;;; (10 "RB: Have 5 bytes into buffer. Adding 4 bytes.\n")

;;; (10 "RB: Requested 9 bytes\n")

;;; (5 "REC[0x1bcef00]: Decrypted Packet[3] Handshake(22) with length: 4\n")

;;; (4 "HSK[0x1bcef00]: SERVER HELLO DONE (14) was received. Length 
0[0], frag offset 0, frag length: 1, sequence: 0\n")

;;; (3 "ASSERT: buffers.c[get_last_packet]:1150\n")

;;; (3 "ASSERT: buffers.c[_gnutls_handshake_io_recv_int]:1379\n")

;;; (4 "HSK[0x1bcef00]: CLIENT KEY EXCHANGE was queued [70 bytes]\n")

;;; (4 "REC[0x1bcef00]: Sent ChangeCipherSpec\n")

;;; (9 "INT: PREMASTER SECRET[32]: 
57b1d15927cf86d5a188845c5f3b91346da69a39de9ebaad9039ee6e7adce1c0\n")

;;; (9 "INT: CLIENT RANDOM[32]: 
590612762d4f41311c6025cee173974704dc319a59b93aeeeb9a504356d147c5\n")

;;; (9 "INT: SERVER RANDOM[32]: 
59061208083e7cef11d8f506f6284a7eb121c7dc28f41b01628843c5fcbfbf6c\n")

;;; (9 "INT: MASTER SECRET: 
6ee6c108de1ef8085719a6b210f77f082842890f32637359d3a2c0ddb7dc7f2405672c1595b12b8de7ab64167669273b\n")

;;; (5 "REC[0x1bcef00]: Initializing epoch #1\n")

;;; (9 "INT: KEY BLOCK[88]: 
2191dfbf92877090f07f26e3a012adb27481fee6f93dfde28ffa73c3b6050842\n")

;;; (9 "INT: CLIENT WRITE KEY [32]: 
2191dfbf92877090f07f26e3a012adb27481fee6f93dfde28ffa73c3b6050842\n")

;;; (9 "INT: SERVER WRITE KEY [32]: 
8cae979022a5925a1d87ff60ca438df85ba9bf0ab23fd748c8c8c4fc28f5024e\n")

;;; (9 "INT: CLIENT WRITE IV [12]: 4112d45c19b24a97e3777ef9\n")

;;; (9 "INT: SERVER WRITE IV [12]: d3c5e030e2354a4a11898074\n")

;;; (5 "REC[0x1bcef00]: Epoch #1 ready\n")

;;; (4 "HSK[0x1bcef00]: Cipher Suite: ECDHE_RSA_CHACHA20_POLY1305\n")

;;; (4 "HSK[0x1bcef00]: Initializing internal [write] cipher sessions\n")

;;; (4 "HSK[0x1bcef00]: recording tls-unique CB (send)\n")

;;; (4 "HSK[0x1bcef00]: FINISHED was queued [16 bytes]\n")

;;; (5 "REC[0x1bcef00]: Preparing Packet Handshake(22) with length: 70 
and min pad: 0\n")

;;; (9 "ENC[0x1bcef00]: cipher: NULL, MAC: MAC-NULL, Epoch: 0\n")

;;; (5 "REC[0x1bcef00]: Sent Packet[2] Handshake(22) in epoch 0 and 
length: 75\n")

;;; (5 "REC[0x1bcef00]: Preparing Packet ChangeCipherSpec(20) with 
length: 1 and min pad: 0\n")

;;; (9 "ENC[0x1bcef00]: cipher: NULL, MAC: MAC-NULL, Epoch: 0\n")

;;; (5 "REC[0x1bcef00]: Sent Packet[3] ChangeCipherSpec(20) in epoch 0 
and length: 6\n")

;;; (5 "REC[0x1bcef00]: Preparing Packet Handshake(22) with length: 16 
and min pad: 0\n")

;;; (9 "ENC[0x1bcef00]: cipher: CHACHA20-POLY1305, MAC: AEAD, Epoch: 1\n")

;;; (5 "REC[0x1bcef00]: Sent Packet[1] Handshake(22) in epoch 1 and 
length: 37\n")

;;; (3 "ASSERT: buffers.c[get_last_packet]:1159\n")

;;; (10 "READ: Got 5 bytes from 0x7\n")

;;; (10 "READ: read 5 bytes from 0x7\n")

;;; (10 "RB: Have 0 bytes into buffer. Adding 5 bytes.\n")

;;; (10 "RB: Requested 5 bytes\n")

;;; (5 "REC[0x1bcef00]: SSL 3.3 Handshake packet received. Epoch 0, 
length: 190\n")

;;; (5 "REC[0x1bcef00]: Expected Packet Handshake(22)\n")

;;; (5 "REC[0x1bcef00]: Received Packet Handshake(22) with length: 190\n")

;;; (10 "READ: Got 190 bytes from 0x7\n")

;;; (10 "READ: read 190 bytes from 0x7\n")

;;; (10 "RB: Have 5 bytes into buffer. Adding 190 bytes.\n")

;;; (10 "RB: Requested 195 bytes\n")

;;; (5 "REC[0x1bcef00]: Decrypted Packet[4] Handshake(22) with length: 
190\n")

;;; (4 "HSK[0x1bcef00]: NEW SESSION TICKET (4) was received. Length 
186[186], frag offset 0, frag length: 186, sequence: 0\n")

;;; (10 "READ: Got 5 bytes from 0x7\n")

;;; (10 "READ: read 5 bytes from 0x7\n")

;;; (10 "RB: Have 0 bytes into buffer. Adding 5 bytes.\n")

;;; (10 "RB: Requested 5 bytes\n")

;;; (5 "REC[0x1bcef00]: SSL 3.3 ChangeCipherSpec packet received. Epoch 
0, length: 1\n")

;;; (5 "REC[0x1bcef00]: Expected Packet ChangeCipherSpec(20)\n")

;;; (5 "REC[0x1bcef00]: Received Packet ChangeCipherSpec(20) with 
length: 1\n")

;;; (10 "READ: Got 1 bytes from 0x7\n")

;;; (10 "READ: read 1 bytes from 0x7\n")

;;; (10 "RB: Have 5 bytes into buffer. Adding 1 bytes.\n")

;;; (10 "RB: Requested 6 bytes\n")

;;; (5 "REC[0x1bcef00]: Decrypted Packet[5] ChangeCipherSpec(20) with 
length: 1\n")

;;; (4 "HSK[0x1bcef00]: Cipher Suite: ECDHE_RSA_CHACHA20_POLY1305\n")

;;; (3 "ASSERT: buffers.c[get_last_packet]:1159\n")

;;; (10 "READ: Got 5 bytes from 0x7\n")

;;; (10 "READ: read 5 bytes from 0x7\n")

;;; (10 "RB: Have 0 bytes into buffer. Adding 5 bytes.\n")

;;; (10 "RB: Requested 5 bytes\n")

;;; (5 "REC[0x1bcef00]: SSL 3.3 Handshake packet received. Epoch 0, 
length: 32\n")

;;; (5 "REC[0x1bcef00]: Expected Packet Handshake(22)\n")

;;; (5 "REC[0x1bcef00]: Received Packet Handshake(22) with length: 32\n")

;;; (10 "READ: Got 32 bytes from 0x7\n")

;;; (10 "READ: read 32 bytes from 0x7\n")

;;; (10 "RB: Have 5 bytes into buffer. Adding 32 bytes.\n")

;;; (10 "RB: Requested 37 bytes\n")

;;; (5 "REC[0x1bcef00]: Decrypted Packet[0] Handshake(22) with length: 
16\n")

;;; (4 "HSK[0x1bcef00]: FINISHED (20) was received. Length 12[12], frag 
offset 0, frag length: 12, sequence: 0\n")

;;; (5 "REC[0x1bcef00]: Start of epoch cleanup\n")

;;; (5 "REC[0x1bcef00]: Epoch #0 freed\n")

;;; (5 "REC[0x1bcef00]: End of epoch cleanup\n")

;;; (10 "READ: Got 5 bytes from 0x7\n")

;;; (10 "READ: read 5 bytes from 0x7\n")

;;; (10 "RB: Have 0 bytes into buffer. Adding 5 bytes.\n")

;;; (10 "RB: Requested 5 bytes\n")

;;; (5 "REC[0x1bcef00]: SSL 3.3 Application Data packet received. Epoch 
0, length: 109\n")

;;; (5 "REC[0x1bcef00]: Expected Packet Application Data(23)\n")

;;; (5 "REC[0x1bcef00]: Received Packet Application Data(23) with 
length: 109\n")

;;; (10 "READ: Got 109 bytes from 0x7\n")

;;; (10 "READ: read 109 bytes from 0x7\n")

;;; (10 "RB: Have 5 bytes into buffer. Adding 109 bytes.\n")

;;; (10 "RB: Requested 114 bytes\n")

;;; (5 "REC[0x1bcef00]: Decrypted Packet[1] Application Data(23) with 
length: 93\n")

--------->8--------->8--------->8--------->8--------->8--------->8--------->8--------->8---------

Can someone help?

Thanks!



^ permalink raw reply	[flat|nested] 4+ messages in thread

* Re: IMAP SSL Connection using Guile
  2017-04-30 16:42 IMAP SSL Connection using Guile Amirouche
@ 2017-05-02 11:58 ` Ludovic Courtès
  2017-05-02 19:47 ` Andy Wingo
  1 sibling, 0 replies; 4+ messages in thread
From: Ludovic Courtès @ 2017-05-02 11:58 UTC (permalink / raw)
  To: guile-user; +Cc: gnutls-help

Hello!

Amirouche <amirouche@hypermove.net> skribis:

> I am trying to connect to an imap server using SSL but it fails. The
> program does
> indeed connect to the remote server, but when I try to read on the
> port it blocks
> until the connection is closed by the remote host.

[...]

> (define (connect-to-server host port)
>   (let ((addrinfo (car (getaddrinfo host (number->string port)))))
>     (let ((port (socket (addrinfo:fam addrinfo)
>                         SOCK_STREAM
>                         IPPROTO_IP)))
>       ;; Disable Nagle's algorithm.  We buffer ourselves.
>       (setsockopt port IPPROTO_TCP TCP_NODELAY 1)
>       (setvbuf port 'block 1024)
>       (connect port (addrinfo:addr addrinfo))
>       port)))

Did you try the exact same code on raw IMAP (without TLS)?

It maybe that the bufferring you’re asking for above is waiting for more
data than can be received at this point according to the IMAP protocol.

HTH,
Ludo’.




^ permalink raw reply	[flat|nested] 4+ messages in thread

* Re: IMAP SSL Connection using Guile
  2017-04-30 16:42 IMAP SSL Connection using Guile Amirouche
  2017-05-02 11:58 ` Ludovic Courtès
@ 2017-05-02 19:47 ` Andy Wingo
  2017-05-03 19:07   ` Amirouche Boubekki
  1 sibling, 1 reply; 4+ messages in thread
From: Andy Wingo @ 2017-05-02 19:47 UTC (permalink / raw)
  To: Amirouche; +Cc: guile-user@gnu.org, gnutls-help

On Sun 30 Apr 2017 18:42, Amirouche <amirouche@hypermove.net> writes:

> I am trying to connect to an imap server using SSL but it fails. The
> program does
> indeed connect to the remote server, but when I try to read on the
> port it blocks
> until the connection is closed by the remote host.
>
> Everything works fine using gnutls-cli.
>
> The version reported by gnutls-cli is 3.5.8

I believe this was fixed in Guile master:
0c102b56e98da39b5a3213bdc567a31ad8ef3e73.  Make appropriate changes to
your copy of tls-wrap :)

Andy



^ permalink raw reply	[flat|nested] 4+ messages in thread

* Re: IMAP SSL Connection using Guile
  2017-05-02 19:47 ` Andy Wingo
@ 2017-05-03 19:07   ` Amirouche Boubekki
  0 siblings, 0 replies; 4+ messages in thread
From: Amirouche Boubekki @ 2017-05-03 19:07 UTC (permalink / raw)
  To: Andy Wingo, Amirouche; +Cc: guile-user@gnu.org, gnutls-help

[-- Attachment #1: Type: text/plain, Size: 971 bytes --]

On Tue, May 2, 2017 at 9:47 PM Andy Wingo <wingo@pobox.com> wrote:

> On Sun 30 Apr 2017 18:42, Amirouche <amirouche@hypermove.net> writes:
>
> > I am trying to connect to an imap server using SSL but it fails. The
> > program does
> > indeed connect to the remote server, but when I try to read on the
> > port it blocks
> > until the connection is closed by the remote host.
> >
> > Everything works fine using gnutls-cli.
> >
> > The version reported by gnutls-cli is 3.5.8
>
> I believe this was fixed in Guile master:
> 0c102b56e98da39b5a3213bdc567a31ad8ef3e73.  Make appropriate changes to
> your copy of tls-wrap :)
>

Tx! It works!

I have a very basic IMAP implementation (without IDLE extensions (which
would avoid the need to poll the server)) but it miss some "verbs" like
the  ability to look up messages by unique identifier UID. What is missing
is explained in that part https://tools.ietf.org/html/rfc3501#section-6.4.8

Thanks again for taking the time.

[-- Attachment #2: imap.scm --]
[-- Type: text/x-scheme, Size: 5819 bytes --]

(define-module (imap))

(use-modules (rnrs bytevectors))
(use-modules (ice-9 binary-ports))
(use-modules (ice-9 iconv))
(use-modules (ice-9 rdelim))
(use-modules (ice-9 textual-ports))
(use-modules ((rnrs io ports)
              #:prefix rnrs-ports:))
(use-modules (gnutls))

(define current-http-proxy
  (make-parameter (let ((proxy (getenv "http_proxy")))
                    (and (not (equal? proxy ""))
                         proxy))))

(define (tls-wrap port server)
   "Return PORT wrapped in a TLS connection to SERVER.  SERVER must be a DNS
host name without trailing dot."
   (define (log level str)
     (format (current-error-port)
             "gnutls: [~a|~a] ~a" (getpid) level str))

   (let ((session (make-session connection-end/client)))
     ;; Some servers such as 'cloud.github.com' require the client to support
     ;; the 'SERVER NAME' extension.  However, 'set-session-server-name!' is
     ;; not available in older GnuTLS releases.  See
     ;; <http://bugs.gnu.org/18526> for details.
     (set-session-server-name! session server-name-type/dns server)
     (set-session-transport-fd! session (fileno port))
     (set-session-default-priority! session)

     ;; The "%COMPAT" bit allows us to work around firewall issues (info
     ;; "(gnutls) Priority Strings"); see <http://bugs.gnu.org/23311>.
     ;; Explicitly disable SSLv3, which is insecure:
     ;; <https://tools.ietf.org/html/rfc7568>.
     (set-session-priorities! session "NORMAL:%COMPAT:-VERS-SSL3.0")

     (set-session-credentials! session (make-certificate-credentials))

     ;; Uncomment the following lines in case of debugging emergency.
     ;;(set-log-level! 10)
     ;;(set-log-procedure! log)

     (handshake session)
     (let ((record (session-record-port session)))
       (define (read! bv start count)
         (define read-bv (get-bytevector-some record))
         (if (eof-object? read-bv)
             0  ; read! returns 0 on eof-object
             (let ((read-bv-len (bytevector-length read-bv)))
               (bytevector-copy! read-bv 0 bv start (min read-bv-len count))
               (when (< count read-bv-len)
                 (unget-bytevector record bv count (-  read-bv-len count)))
               read-bv-len)))
       (define (write! bv start count)
         (put-bytevector record bv start count)
         (force-output record)
         count)
       (define (get-position)
         (rnrs-ports:port-position record))
       (define (set-position! new-position)
         (rnrs-ports:set-port-position! record new-position))
       (define (close)
         (unless (port-closed? port)
           (close-port port))
         (unless (port-closed? record)
           (close-port record)))
       (setvbuf record 'block)
       (make-custom-binary-input/output-port "gnutls wrapped port"
                                             read!
                                             write!
                                             get-position set-position!
                                             close))))
(define (%connect-to-server host port)
  (let ((addrinfo (car (getaddrinfo host (number->string port)))))
    (let ((port (socket (addrinfo:fam addrinfo)
                        SOCK_STREAM
                        IPPROTO_IP)))
      (connect port (addrinfo:addr addrinfo))
      (tls-wrap port host))))

(define (end-of-command line)
  (string-prefix? "azul" line))

(define (maybe-throw string)
  (unless (string-prefix? "azul OK" string)
    (throw 'imap-error (string-drop string (string-length "azul ")))))

(define-public (imap-connect-to-server host port)
  "Connect to imap server found at HOST on PORT, and return the scheme
port to use to communicate with that server"
  (let ((port (%connect-to-server host port)))
    (pk 'welcome (get-line port))
    port))

(define (get-output port)
  (let loop ((line (string-trim-right (get-line port)))
             (out '()))
    (if (end-of-command line)
        (begin
          (maybe-throw line)
          out)
          (loop (string-trim-right (get-line port)) (cons line out)))))

(define-public (imap-capability port)
  "Return the list of capability"
  (put-string port "azul CAPABILITY\r\n")
  (let ((out (get-output port)))
    (string-split (string-drop (car out) (string-length "* CAPABILITY ")) #\space)))

(define-public (imap-noop port)
  "Does NOOP that is all"
  (put-string port "azul NOOP\r\n")
  (get-output port))

(define-public (imap-logout port)
  "Logout and close the port"
  (put-string port "azul LOGOUT\r\n")
  (get-output port)  ;; why is this useful I don't know
  (close port))

(define-public (imap-login port username password)
  "Login using USERNAME and PASSWORD"
  (format port "azul LOGIN ~s ~s\r\n" username password)
  (get-output port))

(define-public (imap-select port mailbox)
  "Select MAILBOX"
  (format port "azul SELECT ~s\r\n" mailbox)
  (get-output port))

(define-public (imap-create port mailbox)
  "Create MAILBOX"
  (format port "azul CREATE ~s\r\n" mailbox)
  (get-output port))

(define-public (imap-delete port mailbox)
  "Delete MAILBOX"
  (format port "azul DELETE ~s\r\n" mailbox)
  (get-output port))

(define-public (imap-rename port old new)
  "Rename mailbox named OLD to NEW"
  (format port "azul RENAME ~s ~s\r\n" old new)
  (get-output port))

;; (define-public (imap-append port mailbox)
;;   "The APPEND command appends the literal argument as a new message to
;; the end of the specified destination mailbox."
;;   )

(define-public (imap-close port)
  (put-string port "azul CLOSE\r\n")
  (get-output port))

;; (define-public (imap-search port

(define port (imap-connect-to-server "imap.gmail.com" 993))

(pk (imap-capability port))
(pk (imap-noop port))
(pk (imap-login port login password))
(pk (imap-select port "INBOX"))
(pk (imap-logout port))

^ permalink raw reply	[flat|nested] 4+ messages in thread

end of thread, other threads:[~2017-05-03 19:07 UTC | newest]

Thread overview: 4+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2017-04-30 16:42 IMAP SSL Connection using Guile Amirouche
2017-05-02 11:58 ` Ludovic Courtès
2017-05-02 19:47 ` Andy Wingo
2017-05-03 19:07   ` Amirouche Boubekki

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).