Skip to content

Fixes weblocks file upload issue #13

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Closed
html wants to merge 7 commits into from
Closed

Fixes weblocks file upload issue #13

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
7 commits
Select commit Hold shift + click to select a range
8c5c0fb
Added extension to randomly generated file name in file-upload parser
html Oct 29, 2012
e018d0a
Fixed cyrillic file names bug
html Oct 29, 2012
df8ec98
Fixed all tests not passing bug
html Oct 30, 2012
8013105
Fixed some tests
html Oct 30, 2012
9712ec9
Fixed test
html Oct 30, 2012
4514ec9
Fixed all tests
html Oct 31, 2012
e209bc9
Added deferred validation feature
html Dec 23, 2012
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
38 changes: 25 additions & 13 deletions src/views/formview/validation.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -24,6 +24,8 @@ messages if any of the functions failed."
t
(values nil errors))))

(defparameter *form-view-validation-max-validation-loops* 5)

(defgeneric validate-object-form-view (object view parsed-values)
(:documentation "Called by the framework during form deserialization
to validate a form view. Default implementation validates each field
Expand All @@ -35,6 +37,9 @@ true. Otherwise returns nil as the first value, and an association
list of either fields and errors or nils and errors (for non-field-related
validation errors) as the second value.

When function returns error equal to :validate-later then validation is done
in several iterations and function will be called again in next iteration.

'object' - the object the form is being deserialized into.
'view' - form view object being deserialized.
'parsed-values' - an association list of field-info structures and
Expand All @@ -43,19 +48,26 @@ parsed values.")
(let ((validates t)
errors
fields-values)
(dolist (info-value-pair parsed-values)
(destructuring-bind (field-info . parsed-value)
info-value-pair
(multiple-value-bind (validatesp error)
(let ((field (field-info-field field-info))
(object (field-info-object field-info)))
(push parsed-value fields-values)
(push (symbol-to-keyword (view-field-slot-name field)) fields-values)
(validate-form-view-field (view-field-slot-name field)
object field view parsed-value))
(unless validatesp
(setf validates nil)
(push-end (cons (field-info-field field-info) error) errors)))))
(loop while parsed-values for i from 1 do
(when (> i *form-view-validation-max-validation-loops*)
(error
"Something went wrong, it seems like validation causes forever loop, be careful using :validate-later. You can also increase weblocks:*form-view-validation-max-validation-loops* which is ~A right now"
*form-view-validation-max-validation-loops*))
(dolist (info-value-pair parsed-values)
(destructuring-bind (field-info . parsed-value)
info-value-pair
(multiple-value-bind (validatesp error)
(let ((field (field-info-field field-info))
(object (field-info-object field-info)))
(push parsed-value fields-values)
(push (symbol-to-keyword (view-field-slot-name field)) fields-values)
(validate-form-view-field (view-field-slot-name field)
object field view parsed-value))
(unless (equal error :validate-later)
(setf parsed-values (remove info-value-pair parsed-values :test #'equal))
(unless validatesp
(setf validates nil)
(push-end (cons (field-info-field field-info) error) errors)))))))
;; We proceed to view-level validation only if individual fields were
;; successfully validated.
(if validates
Expand Down
33 changes: 20 additions & 13 deletions src/views/types/file-upload.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -30,7 +30,7 @@
(:documentation "A parser designed to handle file uploads."))

(defmethod parse-view-field-value ((parser file-upload-parser) value obj
(view form-view) (field form-view-field) &rest args)
(view form-view) (field form-view-field) &rest args)
(declare (ignore args))
(when (null value)
(return-from parse-view-field-value (values t nil)))
Expand All @@ -40,22 +40,29 @@
(flet ((octet-string->utf-8 (s)
"Kludge to fix librfc2388 bug."
(hunchentoot::octets-to-string
(map 'vector
(lambda (c)
(let ((x (char-int c)))
(assert (and (not (minusp x))
(< x 256)))
x))
s))))
(map 'vector
(lambda (c)
(let ((x (char-int c)))
(assert (and (not (minusp x))
(< x 256)))
x))
s)))
(fix-cyrillic-file-name (s)
(babel:octets-to-string
(babel:string-to-octets s :encoding :latin1)
:encoding :utf-8)))
(let* ((temp-path (first value))
(browser-name (octet-string->utf-8 (second value)))
(browser-name (fix-cyrillic-file-name (octet-string->utf-8 (second value))))
(file-name (etypecase (file-upload-parser-file-name parser)
(symbol (ecase (file-upload-parser-file-name parser)
(:browser browser-name)
(:unique (hunchentoot::create-random-string))))
(:unique (concatenate 'string
(hunchentoot::create-random-string)
(or (cl-ppcre:scan-to-strings "\\..*$" browser-name)
"")))))
(string (file-upload-parser-file-name parser)))))
(copy-file temp-path
(merge-pathnames file-name
(file-upload-parser-upload-directory parser))
:if-exists :supersede)
(merge-pathnames file-name
(file-upload-parser-upload-directory parser))
:if-exists :supersede)
(values t value file-name))))
8 changes: 4 additions & 4 deletions test/control-flow/dialog.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -182,7 +182,7 @@
(list (with-javascript-to-string
(ps:ps
(progn
(setf ID-123 "<div class='widget function'><form action='/foo/bar' method='post' onsubmit='initiateFormAction(&quot;abc123&quot;, $(this), &quot;weblocks-session=1%3ATEST&quot;); return false;'><div class='extra-top-1'><!-- empty --></div><div class='extra-top-2'><!-- empty --></div><div class='extra-top-3'><!-- empty --></div><fieldset><p>Please choose</p><input name='a' type='submit' class='submit' value='A' onclick='disableIrrelevantButtons(this);' /><input name='b' type='submit' class='submit' value='B' onclick='disableIrrelevantButtons(this);' /><input name='action' type='hidden' value='abc123' /></fieldset><div class='extra-bottom-1'><!-- empty --></div><div class='extra-bottom-2'><!-- empty --></div><div class='extra-bottom-3'><!-- empty --></div></form></div>")
(setf ID-123 "<div class='widget funcall-widget' id='id-123'><form action='/foo/bar' method='post' onsubmit='initiateFormAction(&quot;abc123&quot;, $(this), &quot;weblocks-session=1%3ATEST&quot;); return false;'><div class='extra-top-1'><!-- empty --></div><div class='extra-top-2'><!-- empty --></div><div class='extra-top-3'><!-- empty --></div><fieldset><p>Please choose</p><input name='a' type='submit' class='submit' value='A' onclick='disableIrrelevantButtons(this);' /><input name='b' type='submit' class='submit' value='B' onclick='disableIrrelevantButtons(this);' /><input name='action' type='hidden' value='abc123' /></fieldset><div class='extra-bottom-1'><!-- empty --></div><div class='extra-bottom-2'><!-- empty --></div><div class='extra-bottom-3'><!-- empty --></div></form></div>")
(setf ID-123 nil)
(weblocks::show-dialog "Select Option"
ID-123
Expand All @@ -209,7 +209,7 @@
(list (with-javascript-to-string
(ps:ps
(progn
(setf ID-123 "<div class='widget function'><form action='/foo/bar' method='post' onsubmit='initiateFormAction(&quot;abc123&quot;, $(this), &quot;weblocks-session=1%3ATEST&quot;); return false;'><div class='extra-top-1'><!-- empty --></div><div class='extra-top-2'><!-- empty --></div><div class='extra-top-3'><!-- empty --></div><fieldset><p>Please confirm</p><input name='ok' type='submit' class='submit' value='Ok' onclick='disableIrrelevantButtons(this);' /><input name='cancel' type='submit' class='submit' value='Cancel' onclick='disableIrrelevantButtons(this);' /><input name='action' type='hidden' value='abc123' /></fieldset><div class='extra-bottom-1'><!-- empty --></div><div class='extra-bottom-2'><!-- empty --></div><div class='extra-bottom-3'><!-- empty --></div></form></div>")
(setf ID-123 "<div class='widget funcall-widget' id='id-123'><form action='/foo/bar' method='post' onsubmit='initiateFormAction(&quot;abc123&quot;, $(this), &quot;weblocks-session=1%3ATEST&quot;); return false;'><div class='extra-top-1'><!-- empty --></div><div class='extra-top-2'><!-- empty --></div><div class='extra-top-3'><!-- empty --></div><fieldset><p>Please confirm</p><input name='ok' type='submit' class='submit' value='Ok' onclick='disableIrrelevantButtons(this);' /><input name='cancel' type='submit' class='submit' value='Cancel' onclick='disableIrrelevantButtons(this);' /><input name='action' type='hidden' value='abc123' /></fieldset><div class='extra-bottom-1'><!-- empty --></div><div class='extra-bottom-2'><!-- empty --></div><div class='extra-bottom-3'><!-- empty --></div></form></div>")
(setf ID-123 nil)
(weblocks::show-dialog "Confirmation"
ID-123
Expand All @@ -225,7 +225,7 @@
(list (with-javascript-to-string
(ps:ps
(progn
(setf ID-123 "<div class='widget function'><form action='/foo/bar' method='post' onsubmit='initiateFormAction(&quot;abc123&quot;, $(this), &quot;weblocks-session=1%3ATEST&quot;); return false;'><div class='extra-top-1'><!-- empty --></div><div class='extra-top-2'><!-- empty --></div><div class='extra-top-3'><!-- empty --></div><fieldset><p>Please confirm</p><input name='yes' type='submit' class='submit' value='Yes' onclick='disableIrrelevantButtons(this);' /><input name='no' type='submit' class='submit' value='No' onclick='disableIrrelevantButtons(this);' /><input name='action' type='hidden' value='abc123' /></fieldset><div class='extra-bottom-1'><!-- empty --></div><div class='extra-bottom-2'><!-- empty --></div><div class='extra-bottom-3'><!-- empty --></div></form></div>")
(setf ID-123 "<div class='widget funcall-widget' id='id-123'><form action='/foo/bar' method='post' onsubmit='initiateFormAction(&quot;abc123&quot;, $(this), &quot;weblocks-session=1%3ATEST&quot;); return false;'><div class='extra-top-1'><!-- empty --></div><div class='extra-top-2'><!-- empty --></div><div class='extra-top-3'><!-- empty --></div><fieldset><p>Please confirm</p><input name='yes' type='submit' class='submit' value='Yes' onclick='disableIrrelevantButtons(this);' /><input name='no' type='submit' class='submit' value='No' onclick='disableIrrelevantButtons(this);' /><input name='action' type='hidden' value='abc123' /></fieldset><div class='extra-bottom-1'><!-- empty --></div><div class='extra-bottom-2'><!-- empty --></div><div class='extra-bottom-3'><!-- empty --></div></form></div>")
(setf ID-123 nil)
(weblocks::show-dialog "Confirmation"
ID-123
Expand All @@ -251,7 +251,7 @@
(list (with-javascript-to-string
(ps:ps
(progn
(setf ID-123 "<div class='widget function'><form action='/foo/bar' method='post' onsubmit='initiateFormAction(&quot;abc123&quot;, $(this), &quot;weblocks-session=1%3ATEST&quot;); return false;'><div class='extra-top-1'><!-- empty --></div><div class='extra-top-2'><!-- empty --></div><div class='extra-top-3'><!-- empty --></div><fieldset><p>FYI</p><input name='ok' type='submit' class='submit' value='Ok' onclick='disableIrrelevantButtons(this);' /><input name='action' type='hidden' value='abc123' /></fieldset><div class='extra-bottom-1'><!-- empty --></div><div class='extra-bottom-2'><!-- empty --></div><div class='extra-bottom-3'><!-- empty --></div></form></div>")
(setf ID-123 "<div class='widget funcall-widget' id='id-123'><form action='/foo/bar' method='post' onsubmit='initiateFormAction(&quot;abc123&quot;, $(this), &quot;weblocks-session=1%3ATEST&quot;); return false;'><div class='extra-top-1'><!-- empty --></div><div class='extra-top-2'><!-- empty --></div><div class='extra-top-3'><!-- empty --></div><fieldset><p>FYI</p><input name='ok' type='submit' class='submit' value='Ok' onclick='disableIrrelevantButtons(this);' /><input name='action' type='hidden' value='abc123' /></fieldset><div class='extra-bottom-1'><!-- empty --></div><div class='extra-bottom-2'><!-- empty --></div><div class='extra-bottom-3'><!-- empty --></div></form></div>")
(setf ID-123 nil)
(weblocks::show-dialog "Information"
ID-123
Expand Down
19 changes: 1 addition & 18 deletions test/debug-mode.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,21 +1,4 @@

(in-package weblocks-test)

;;; test render-debug-toolbar
(deftest-html render-debug-toolbar-1
(with-request :get nil
(weblocks::render-debug-toolbar))
(:div :class "debug-toolbar"
(:a :href "/foo/bar?action=debug-reset-sessions"
:title "Reset Sessions"
(:img :src "/pub/images/reset.png"
:alt "Reset Sessions"))))

;;; test initialize-debug-actions
(deftest initialize-debug-actions-1
(with-request :get nil
(weblocks::initialize-debug-actions)
(apply #'values (mapcar (lambda (str)
(not (null (webapp-session-value str))))
'("debug-reset-sessions"))))
t)
; All tests were deprecated, waiting for new
14 changes: 11 additions & 3 deletions test/page-template.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -15,9 +15,12 @@
(curry-after #'make-local-dependency :do-not-probe t))
'((:stylesheet "foo")
(:stylesheet "bar"))))
(*current-page-description* "Some Page"))
(*current-page-description* "Some Page")
(*current-page-title* "Some Page")
(*current-page-keywords* nil)
(*current-page-headers* nil))
(declare (special weblocks::*page-dependencies*
*current-page-description*))
*current-page-description* *current-page-title* *current-page-keywords* *current-page-headers*))
(with-html
(:div "test"))
(weblocks::render-page (weblocks::current-webapp))))
Expand All @@ -29,6 +32,7 @@
(:head
(:title "some-name - Some Page")
(:meta :http-equiv "Content-type" :content "text/html; charset=utf-8")
(:meta :name "description" :value "Some Page")
(:link :rel "stylesheet" :type "text/css" :href "/some-name/pub/stylesheets/layout.css")
(:link :rel "stylesheet" :type "text/css" :href "/some-name/pub/stylesheets/main.css")
(:link :rel "stylesheet" :type "text/css" :href "/some-name/pub/stylesheets/dialog.css")
Expand All @@ -48,4 +52,8 @@
(:div :class "page-extra-bottom-1" "<!-- empty -->")
(:div :class "page-extra-bottom-2" "<!-- empty -->")
(:div :class "page-extra-bottom-3" "<!-- empty -->"))
(:div :id "ajax-progress" "&nbsp;")))))
(:div :id "ajax-progress" "&nbsp;")
(:script :type "text/javascript"
(fmt "~%// <![CDATA[~%")
(fmt "updateWidgetStateFromHash();")
(fmt "~%// ]]>~%"))))))
9 changes: 6 additions & 3 deletions test/test-code/weblocks-suite.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -35,15 +35,18 @@
(make-action-orig
generate-widget-id-orig)
(:dynamic-variables (*acceptor* (make-instance 'unittest-server))
(*weblocks-server* *acceptor*)
(*request* (make-instance 'unittest-request :acceptor *acceptor*))
(*weblocks-server*)
(*request*)
(hunchentoot::*reply* (make-instance 'hunchentoot::reply))
(weblocks::*dirty-widgets* nil)
(*weblocks-output-stream* (make-string-output-stream))
*uri-tokens* *on-ajax-complete-scripts*
*before-ajax-complete-scripts*
weblocks::*page-dependencies*)
(:setup (setf (slot-value *request* 'method) :get)
(:setup
(setf *weblocks-server* *acceptor*)
(setf *request* (make-instance 'unittest-request :acceptor *acceptor*))
(setf (slot-value *request* 'method) :get)
(setf generate-widget-id-orig #'gen-id)
(setf (symbol-function 'gen-id)
(lambda (&optional prefix)
Expand Down
4 changes: 2 additions & 2 deletions test/utils-test/misc.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -263,11 +263,11 @@

;;; test find-all
(deftest find-all-1
(find-all '(1 2 3 4 5 6) #'oddp)
(weblocks::find-all '(1 2 3 4 5 6) #'oddp)
(1 3 5))

(deftest find-all-2
(find-all '(1 2 3 4 5 6) #'oddp :key #'1+)
(weblocks::find-all '(1 2 3 4 5 6) #'oddp :key #'1+)
(2 4 6))

;;; test stable-set-difference
Expand Down
1 change: 0 additions & 1 deletion test/views/formview/test-template.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,6 @@
(:h1 (:span :class "action" (str ,title-action))
(:span :class "object" ,(humanize-name data-class-name)))
,@preslots
(:h2 :class "form-fields-title" "Form fields:")
(:ul ,@body)
,@postslots
(:input :name "action" :type "hidden" :value ,action))
Expand Down
1 change: 1 addition & 0 deletions test/weblocks-test.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -93,6 +93,7 @@ package. This function tests weblocks in a clean environment. See
Pass NIL as the optional arg to just return the results instead of
DESCRIBE-ing them."
;; XXX better results combination
(setf weblocks::*dirty-widgets* nil)
(let ((results (list (run-tests :suite 'weblocks-suite)
(run-tests :suite 'weblocks-store-test::store-suite))))
(when verbose
Expand Down
Loading