493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
|
(define (sendmail to_addr subject body
#!key
(from_addr "admin")
cc_addr
bcc_addr
more-headers
use_html
(attach-files-list '()))
(define (sendmail-proc sendmail-port)
(define (wl line-str)
(write-line line-str sendmail-port))
(define (get-uuid)
(string-upcase (uuid->string (uuid-generate))))
|
|
>
>
|
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
|
(define (sendmail to_addr subject body
#!key
(from_addr "admin")
cc_addr
bcc_addr
more-headers
use_html
(attach-files-list '())
(images-with-content-id-alist '())
)
(define (sendmail-proc sendmail-port)
(define (wl line-str)
(write-line line-str sendmail-port))
(define (get-uuid)
(string-upcase (uuid->string (uuid-generate))))
|
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
|
(wl "MIME-Version: 1.0")
(wl (conc "Content-Type: multipart/mixed; boundary=\"" mailpart-uuid "\""))
(wl "")
(boundary)
(wl (conc "Content-Type: multipart/alternative; boundary=\"" mailpart-body-uuid "\""))
(wl "")
)
(define (email-text-body)
(body-boundary)
(wl "Content-Type: text/plain; charset=ISO-8859-1")
(wl "Content-Disposition: inline")
(wl "")
(wl body)
(body-boundary))
(define (email-html-body)
(body-boundary)
(wl "Content-Type: text/plain; charset=ISO-8859-1")
(wl "")
(wl "You need to enable HTML option for email")
(body-boundary)
(wl "Content-Type: text/html; charset=ISO-8859-1")
(wl "Content-Disposition: inline")
(wl "")
(wl body)
(body-boundary))
(define (attach-file file)
|
>
|
|
>
>
>
>
>
>
>
>
|
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
|
(wl "MIME-Version: 1.0")
(wl (conc "Content-Type: multipart/mixed; boundary=\"" mailpart-uuid "\""))
(wl "")
(boundary)
(wl (conc "Content-Type: multipart/alternative; boundary=\"" mailpart-body-uuid "\""))
(wl "")
)
(define (email-text-body)
(body-boundary)
(wl "Content-Type: text/plain; charset=ISO-8859-1")
(wl "Content-Disposition: inline")
(wl "")
(wl body)
(body-boundary))
(define (email-html-body)
(body-boundary)
(wl "Content-Type: text/plain; charset=ISO-8859-1")
(wl "")
(wl "You need to enable HTML option for email")
(body-boundary)
(wl "Content-Type: text/html; charset=ISO-8859-1")
(wl "Content-Disposition: inline")
(wl "")
(wl body)
(body-boundary))
(define (attach-file file #!key (content-id #f))
(let* ((filename
(filepath:take-file-name file))
(ext-with-dot
(filepath:take-extension file))
(ext (string-take-right
ext-with-dot
(- (string-length ext-with-dot) 1)))
(mimetype (ext->mimetype ext))
(uuencode-command (conc "uuencode " file " " filename)))
(boundary)
(wl (conc "Content-Type: " mimetype "; name=\"" filename "\""))
(wl "Content-Transfer-Encoding: uuencode")
(if content-id
(wl (conc "Content-Id: " content-id)))
(wl (conc "Content-Disposition: attachment; filename=\"" filename "\""))
(wl "")
(do-or-die
uuencode-command
foreach-stdout:
(lambda (line)
(wl line)))))
(define (embed-image file+content-id)
(let ((file (car file+content-id))
(content-id (cdr file+content-id)))
(attach-file file content-id: content-id)))
;; send the email
(email-mime-header)
(if use_html
(email-html-body)
(email-text-body))
(for-each attach-file attach-files-list)
(for-each embed-image images-with-content-id-alist)
(boundary)
(close-output-port sendmail-port)))
(do-or-die "/usr/sbin/sendmail -t"
stdin-proc: sendmail-proc))
;; like shell "which" command
|