Changeset 14913 in project


Ignore:
Timestamp:
06/06/09 16:52:20 (10 years ago)
Author:
azul
Message:

Allow a user subscribing others to provide a message. Improve the error shown when the maximum number of subscriptions an IP address can make is reached. Lower 'max-subscriptions-per-day' to 20. Show 'Email' instead of 'Subscribe' in the files-actions-links.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/3/svnwiki-mail/trunk/svnwiki-mail.scm

    r14853 r14913  
    1414                (get-props-parents-first "svnwiki:application-url" path-in path)
    1515                path)
    16         "Subscribe"))))
     16        "Email"))))
    1717
    1818(define (mail-request-handle env)
     
    8181                    (random (string-length *random-password-chars*)))))))
    8282
    83 (define *max-subscriptions-per-day* 100)
     83(define *max-subscriptions-per-day* 20)
    8484
    8585(define (subscribe-address-commit env)
     
    9696            env
    9797            (html-stream
    98               "Address " address " has already reached the maximum number of subscriptions permited per day.  It was not subscribed.")))))))
     98              "You have reached the maximum number of subscriptions permitted per day (based on your IP address).  Address " address " was not subscribed.  Try again tomorrow.")))))))
    9999
    100100(test-group svnwiki-mail-path-show
     
    246246        (svnwiki-format #t "may speed up the unsubscription process should you decide to do it.~%")))))
    247247
     248(define *max-length-confirmation-message* 300)
     249
    248250(define (send-confirmation-mail env address)
    249251  (assert (and 'send-confirmation-mail address))
    250   (let-from-environment env (static-url path path-in)
     252  (let-from-environment env (static-url path path-in user-input)
    251253    (send-no-reply-mail env address
    252254      (lambda (from)
    253255        (svnwiki-format #t "From: ~A~%" from)
    254256        (svnwiki-format #t "To: ~A~%" address)
    255         (svnwiki-format #t "Subject: ~A: Confirmation required~%~%" (svnwiki-mail-path-show path))
    256         (svnwiki-format #t "We have received a subscription request from ~A~%" (get-subscribe-submitter env))
    257         (svnwiki-format #t "for this email address for the following page:~%~%")
    258         (svnwiki-format #t "  ~A~A~%~%" static-url path)
    259         (svnwiki-format #t "In order to confirm this request and receive notifications about~%")
    260         (svnwiki-format #t "modifications to this page and new messages posted to its discussion,~%")
    261         (svnwiki-format #t "go to:~%~%")
    262         (svnwiki-format #t "  ~A~A?action=extension&extension=mail&request=confirmform&address=~A~%~%"
    263                         (get-props-parents-first "svnwiki:application-url" path-in path #f)
    264                         path
    265                         (url-encode-stream address))
    266         (svnwiki-format #t "and enter your administration password:~%~%")
    267         (let ((password (get-password-for-address env address)))
    268           (unless password
    269             (error "send-confirmation-mail: Unable to load password for address" address))
    270           (svnwiki-format #t "  Password: ~A~%~%" password))
    271         (svnwiki-format #t "By doing this you will allow others to subscribe you to other pages in~%")
    272         (svnwiki-format #t "this site.~%~%")
    273         (let ((pages (mail-db-run env "SELECT page FROM subscriptions WHERE address = ? AND page <> ?;" address (svnwiki-mail-path-canonical path))))
    274           (unless (stream-null? pages)
    275             (svnwiki-format #t "You will also be confirming your subscription to the following pages:~%~%")
    276             (stream-for-each
    277               (lambda (p)
    278                 (svnwiki-format #t "  ~A~A~%" static-url (vector-ref p 0)))
    279               pages)
    280             (newline)))
    281         (svnwiki-format #t "If you don't want to be subscribed, disregard this message: you won't be~%")
    282         (svnwiki-format #t "subscribed to any page in this site.~%")))))
     257        (svnwiki-format #t "Subject: ~A: Subscription request~%" (svnwiki-mail-path-show path))
     258        (svnwiki-format #t "MIME-Version: 1.0 (svnwiki mail extension $Rev: 12412 $)~%")
     259        (svnwiki-format #t "Content-type: text/plain; charset=~A~%" (svnwiki-encoding-for-file env))
     260        ; TODO: quoted-printable would be nicer
     261        (svnwiki-format #t "Content-Transfer-Encoding: base64~%~%")
     262        (write-stream
     263          (base64-encode
     264            (with-output-to-stream
     265              (lambda ()
     266                (svnwiki-format #t "Message sent by: ~A~%~%" (get-subscribe-submitter env))
     267                (let ((message (user-input 'message stream-null)))
     268                  (unless (stream-null? message)
     269                    (svnwiki-format #t "~A~%~%" (svnwiki-stream-cut-with-ellipsis message *max-length-confirmation-message*))
     270                    (svnwiki-format #t "----~%")))
     271                (svnwiki-format #t "This is a subscription request for the following page:~%~%")
     272                (svnwiki-format #t "  ~A~A~%~%" static-url path)
     273                (svnwiki-format #t "If you want to confirm this request and receive notifications about~%")
     274                (svnwiki-format #t "modifications to this page and new messages posted to its discussion,~%")
     275                (svnwiki-format #t "go to:~%~%")
     276                (svnwiki-format #t "  ~A~A?action=extension&extension=mail&request=confirmform&address=~A~%~%"
     277                                (get-props-parents-first "svnwiki:application-url" path-in path #f)
     278                                path
     279                                (url-encode-stream address))
     280                (svnwiki-format #t "and enter your administration password:~%~%")
     281                (let ((password (get-password-for-address env address)))
     282                  (unless password
     283                    (error "send-confirmation-mail: Unable to load password for address" address))
     284                  (svnwiki-format #t "  Password: ~A~%~%" password))
     285                (svnwiki-format #t "By doing this you will allow others to subscribe you to other pages in~%")
     286                (svnwiki-format #t "this site.~%~%")
     287                (let ((pages (mail-db-run env "SELECT page FROM subscriptions WHERE address = ? AND page <> ?;" address (svnwiki-mail-path-canonical path))))
     288                  (unless (stream-null? pages)
     289                    (svnwiki-format #t "You will also be confirming your subscription to the following pages:~%~%")
     290                    (stream-for-each
     291                      (lambda (p)
     292                        (svnwiki-format #t "  ~A~A~%" static-url (vector-ref p 0)))
     293                      pages)
     294                    (newline)))
     295                (svnwiki-format #t "Disregard this message and you won't be subscribed to any pages~%")
     296                (svnwiki-format #t "in this site.~%")))))))))
    283297
    284298(define (mail-request-subscribe-show-list desc s)
     
    472486              (br)
    473487              (subscribe-options->html (options-list-paths env)))
    474            (p "If you want to also subscribe other people, enter their email addresses (separated by commas)."
     488           (p "If you want to also subscribe other people, enter their email addresses (separated by commas):"
    475489              (br)
    476490              ((textarea
     
    480494                 style "width: 100%")
    481495               (user-input 'email-invites stream-null)))
     496           (p "Message (optional):"
     497              (br)
     498              ((input type "text" name "message" maxlength "300" style "width: 100%")))
    482499           ((input type "submit" value "Subscribe"))))
    483500        'view))))
Note: See TracChangeset for help on using the changeset viewer.