Merge branch 'maint-string-html-escape' of https://github.com/christopherlam/gnucash into maint

This commit is contained in:
Geert Janssens 2018-04-27 19:06:23 +02:00
commit 3e41bb011d
16 changed files with 153 additions and 146 deletions

View File

@ -73,7 +73,6 @@ SET (report_system_SCHEME_3
html-table.scm
html-text.scm
html-utilities.scm
html-jqplot.scm
options-utilities.scm
report-utilities.scm
report.scm

View File

@ -21,7 +21,7 @@
;; Boston, MA 02110-1301, USA gnu@gnu.org
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(load-from-path "html-jqplot")
(use-modules (gnucash report report-system))
(define <html-barchart>
(make-record-type "<html-barchart>"
@ -135,24 +135,6 @@
(define gnc:html-barchart-subtitle
(record-accessor <html-barchart> 'subtitle))
;; Note: Due to Bug726449 the input string's non-printable control
;; characters must translated to HTML format tags BEFORE
;; or WHEN calling this function.
;; AND:
;; To ensure that the generated subtitle doesn't contain any
;; unescaped quotes or backslashes, all strings must be freed
;; from those by calling jqplot-escape-string.
;; Otherwise we're opening the gates again for bug 721768.
;;
;; Example: "\n" must be translated to "<br /> to introduce
;; a line break into the chart subtitle.
;;
;; Example call:
;; (gnc:html-barchart-set-subtitle! chart
;; (string-append "Bgt:"
;; (jqplot-escape-string (number->string bgt-sum))
;; "<br /> Act:" ;; line break in the chart sub-title
;; (jqplot-escape-string (number->string act-sum))))
(define gnc:html-barchart-set-subtitle!
(record-modifier <html-barchart> 'subtitle))
@ -372,9 +354,9 @@
(push "data.push(d")
(push series-index)
(push ");\n")
(push "series.push({ label: \"")
(push (jqplot-escape-string label))
(push "\"});\n\n")))
(push (format #f "series.push({ label: ~s });\n\n"
(gnc:html-string-sanitize label)))
))
; Use a unique chart-id for each chart. This prevents chart
; clashed on multi-column reports
(chart-id (string-append "chart-" (number->string (random 999999)))))
@ -485,16 +467,13 @@
"false;\n"))
(if title
(begin
(push " options.title = \"")
(push (jqplot-escape-string title))
(push "\";\n")))
(push (format #f " options.title = ~s;\n"
(gnc:html-string-sanitize title))))
(if subtitle
(begin
(push " options.title += \" <br />")
(push subtitle)
(push "\";\n")))
(push (format #f " options.title += ' <br />' + ~s;\n"
(gnc:html-string-sanitize subtitle))))
(if (and (string? x-label) (> (string-length x-label) 0))
(begin

View File

@ -1,44 +0,0 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2 of
;; the License, or (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, contact:
;;
;; Free Software Foundation Voice: +1-617-542-5942
;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
;; Boston, MA 02110-1301, USA gnu@gnu.org
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(use-modules (gnucash core-utils))
(define (gnc:html-js-include file)
(string-append
"<script language=\"javascript\" type=\"text/javascript\" src=\"file:///"
(gnc-path-find-localized-html-file file)
"\"></script>\n"
))
(define (gnc:html-css-include file)
(string-append
"<link rel=\"stylesheet\" type=\"text/css\" href=\"file:///"
(gnc-path-find-localized-html-file file)
"\" />\n"
))
(define (jqplot-escape-string s1)
;; Escape single and double quotes and backslashes
(set! s1 (regexp-substitute/global #f "\\\\" s1 'pre "\\\\" 'post))
(set! s1 (regexp-substitute/global #f "'" s1 'pre "\\'" 'post))
(set! s1 (regexp-substitute/global #f "\"" s1 'pre "\\\"" 'post))
;; Escape HTML special characters
(set! s1 (regexp-substitute/global #f "&" s1 'pre "&amp;" 'post))
(set! s1 (regexp-substitute/global #f "<" s1 'pre "&lt;" 'post))
(regexp-substitute/global #f ">" s1 'pre "&gt;" 'post))

View File

@ -24,6 +24,8 @@
;; Boston, MA 02110-1301, USA gnu@gnu.org
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(use-modules (gnucash report report-system))
(define <html-linechart>
(make-record-type "<html-linechart>"
'(width
@ -408,9 +410,8 @@
(push "data.push(d")
(push series-index)
(push ");\n")
(push "series.push({ label: \"")
(push (jqplot-escape-string label))
(push "\"});\n\n")))
(push (format #f "series.push({ label: ~s });\n\n"
(gnc:html-string-sanitize label)))))
; Use a unique chart-id for each chart. This prevents chart
; clashed on multi-column reports
(chart-id (string-append "chart-" (number->string (random 999999)))))
@ -526,16 +527,12 @@
"false;\n"))
(if title
(begin
(push " options.title = \"")
(push (jqplot-escape-string title))
(push "\";\n")))
(push (format #f " options.title = ~s;\n"
(gnc:html-string-sanitize title))))
(if subtitle
(begin
(push " options.title += \" <br />")
(push subtitle)
(push "\";\n")))
(push (format #f " options.title += ' <br />' + ~s;\n"
(gnc:html-string-sanitize subtitle))))
(if (and (string? x-label) (> (string-length x-label) 0))
(begin

View File

@ -21,7 +21,7 @@
;; Boston, MA 02110-1301, USA gnu@gnu.org
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(load-from-path "html-jqplot")
(use-modules (gnucash report report-system))
(define <html-piechart>
(make-record-type "<html-piechart>"
@ -231,11 +231,9 @@
(begin
(for-each
(lambda (datum label)
(push " data.push(['")
(push (jqplot-escape-string label))
(push "',")
(push datum)
(push "]);\n"))
(push (format #f " data.push([~s,~a]);\n"
(gnc:html-string-sanitize label)
datum)))
data (gnc:html-piechart-labels piechart))))
(push "var options = {
@ -253,15 +251,12 @@
};\n")
(if title
(begin
(push " options.title = \"")
(push (jqplot-escape-string title))
(push "\";\n")))
(push (format #f " options.title = ~s;\n"
(gnc:html-string-sanitize title))))
(if subtitle
(begin
(push " options.title += \" (")
(push (jqplot-escape-string subtitle))
(push ")\";\n")))
(push (format #f " options.title += ' (' + ~s + ')';\n"
(gnc:html-string-sanitize subtitle))))
(if (not (equal? colors-str ""))
(begin ; example: options.seriesColors= ["blue", "red"];
(push "options.seriesColors = [")

View File

@ -24,7 +24,7 @@
;; Boston, MA 02110-1301, USA gnu@gnu.org
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(load-from-path "html-jqplot")
(use-modules (gnucash report report-system))
(define <html-scatter>
(make-record-type "<html-scatter>"
@ -205,14 +205,12 @@
};\n")
(if title
(begin
(push " options.title = \"")
(push title) (push "\";\n")))
(push (format #f " options.title = ~s;\n"
(gnc:html-string-sanitize title))))
(if subtitle
(begin
(push " options.title += \" (")
(push subtitle) (push ")\";\n")))
(push (format #f " options.title += ' (' + ~s + ')';\n"
(gnc:html-string-sanitize subtitle))))
(if (and (string? x-label) (> (string-length x-label) 0))
(begin

View File

@ -853,3 +853,27 @@
report-id
(_ "No data")
(_ "The selected accounts contain no data/transactions (or only zeroes) for the selected time period")))
(define (gnc:html-js-include file)
(format #f
"<script language=\"javascript\" type=\"text/javascript\" src=\"file:///~a\"></script>\n"
(gnc-path-find-localized-html-file file)))
(define (gnc:html-css-include file)
(format #f
"<link rel=\"stylesheet\" type=\"text/css\" href=\"file:///~a\" />\n"
(gnc-path-find-localized-html-file file)))
;; function to sanitize strings prior to sending to html
(define (gnc:html-string-sanitize str)
(with-output-to-string
(lambda ()
(string-for-each
(lambda (c)
(display
(case c
((#\&) "&amp;")
((#\<) "&lt;")
((#\>) "&gt;")
(else c))))
str))))

View File

@ -119,6 +119,9 @@
(export gnc:html-make-generic-simple-warning)
(export gnc:html-make-empty-data-warning)
(export gnc:html-make-options-link)
(export gnc:html-js-include)
(export gnc:html-css-include)
(export gnc:html-string-sanitize)
;; report.scm
(export gnc:menuname-reports)

View File

@ -15,6 +15,10 @@ SET(scm_test_report_system_SOURCES
test-list-extras.scm
test-report-utilities.scm
# test-test-extras.scm ;;FIXME why is this not run
)
set (scm_test_report_system_with_srfi64_SOURCES
test-html-utilities-srfi64.scm
)
set(GUILE_DEPENDS
@ -29,6 +33,10 @@ set(GUILE_DEPENDS
)
GNC_ADD_SCHEME_TESTS(${scm_test_report_system_SOURCES})
if (HAVE_SRFI64)
gnc_add_scheme_tests ("${scm_test_report_system_with_srfi64_SOURCES}")
endif (HAVE_SRFI64)
GNC_ADD_SCHEME_TARGETS(scm-test-report-system
"test-extras.scm"
gnucash/report/report-system/test
@ -46,7 +54,7 @@ GNC_ADD_SCHEME_TARGETS(scm-test-report-system-2
add_dependencies(check scm-test-report-system)
SET_DIST_LIST(test_report_system_DIST
CMakeLists.txt
${scm_test_report_system_with_srfi64_SOURCES}
${scm_test_report_system_SOURCES}
test-extras.scm
test-link-module.c

View File

@ -0,0 +1,74 @@
(use-modules (gnucash gnc-module))
(gnc:module-begin-syntax (gnc:module-load "gnucash/app-utils" 0))
(gnc:module-begin-syntax (gnc:module-load "gnucash/report/report-system" 0))
(use-modules (gnucash engine test test-extras))
(use-modules (gnucash report report-system test test-extras))
(use-modules (gnucash report report-system))
(use-modules (srfi srfi-64))
(define (test-runner)
(let ((runner (test-runner-null))
(num-passed 0)
(num-failed 0))
(test-runner-on-test-end! runner
(lambda (runner)
(format #t "[~a] line:~a, test: ~a\n"
(test-result-ref runner 'result-kind)
(test-result-ref runner 'source-line)
(test-runner-test-name runner))
(case (test-result-kind runner)
((pass xpass) (set! num-passed (1+ num-passed)))
((fail xfail)
(if (test-result-ref runner 'expected-value)
(format #t "~a\n -> expected: ~s\n -> obtained: ~s\n"
(string-join (test-runner-group-path runner) "/")
(test-result-ref runner 'expected-value)
(test-result-ref runner 'actual-value)))
(set! num-failed (1+ num-failed)))
(else #t))))
(test-runner-on-final! runner
(lambda (runner)
(format #t "Source:~a\npass = ~a, fail = ~a\n"
(test-result-ref runner 'source-file) num-passed num-failed)
(zero? num-failed)))
runner))
(define (run-test)
(test-runner-factory test-runner)
(test-begin "test-html-utilities-srfi64.scm")
(test-gnc:html-string-sanitize)
(test-end "test-html-utilities-srfi64.scm"))
(define (test-gnc:html-string-sanitize)
(test-begin "gnc:html-string-sanitize")
(test-equal "null test"
"abc"
(gnc:html-string-sanitize "abc"))
(test-equal "sanitize &copy;"
"&amp;copy;"
(gnc:html-string-sanitize "&copy;"))
(test-equal "emoji unchanged"
"🎃"
(gnc:html-string-sanitize "🎃"))
(test-equal "complex string"
"Smiley:\"🙂\" something"
(gnc:html-string-sanitize "Smiley:\"🙂\" something"))
(test-equal "sanitize <b>bold tags</b>"
"&lt;b&gt;bold tags&lt;/b&gt;"
(gnc:html-string-sanitize "<b>bold tags</b>"))
(test-equal "quotes are unchanged for html"
"\""
(gnc:html-string-sanitize "\""))
(test-equal "backslash is unchanged for html"
"\\"
(gnc:html-string-sanitize "\\"))
(test-end "gnc:html-string-sanitize"))

View File

@ -27,7 +27,6 @@
(use-modules (gnucash utilities))
(use-modules (srfi srfi-1))
(use-modules (ice-9 regex))
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))

View File

@ -33,10 +33,6 @@
(gnc:module-load "gnucash/report/report-system" 0)
;; included since Bug726449
(use-modules (ice-9 regex)) ;; for regexp-substitute/global, used by jpqplot
(load-from-path "html-jqplot") ;; for jqplot-escape-string
(define reportname
(N_ "Budget Chart"))
@ -238,14 +234,8 @@
(gnc:html-barchart-append-column! chart act-vals)
(gnc:html-barchart-set-row-labels! chart date-iso-string-list)
(if running-sum
(gnc:html-barchart-set-subtitle! chart
(string-append "Bgt:"
(jqplot-escape-string (number->string bgt-sum))
"<br /> Act:"
(jqplot-escape-string (number->string act-sum))
)
)
)
(gnc:html-barchart-set-subtitle!
chart (format #f "Bgt: ~a Act: ~a" bgt-sum act-sum)))
)
;; else
(begin
@ -254,14 +244,9 @@
(gnc:html-linechart-append-column! chart act-vals)
(gnc:html-linechart-set-row-labels! chart date-iso-string-list)
(if running-sum
(gnc:html-linechart-set-subtitle! chart
(string-append "Bgt:"
(jqplot-escape-string (number->string bgt-sum))
"<br /> Act:"
(jqplot-escape-string (number->string act-sum))
)
)
)
(gnc:html-linechart-set-subtitle!
chart
(format #f "Bgt: ~a Act: ~a" bgt-sum act-sum)))
)
)
)

View File

@ -28,16 +28,11 @@
(use-modules (gnucash report report-system collectors))
(use-modules (srfi srfi-1))
(use-modules (gnucash utilities))
(use-modules (ice-9 regex))
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))
(gnc:module-load "gnucash/report/report-system" 0)
;; included since Bug726449
(use-modules (ice-9 regex)) ;; for regexp-substitute/global, used by jpqplot
(load-from-path "html-jqplot") ;; for jqplot-escape-string
;; The option names are defined here to 1. save typing and 2. avoid
;; spelling errors. The *reportnames* are defined here (and not only
;; once at the very end) because I need them to define the "other"
@ -534,8 +529,8 @@ developing over time"))
(if do-intervals?
(_ "~a to ~a")
(_ "Balances ~a to ~a"))
(jqplot-escape-string (qof-print-date from-date-t64))
(jqplot-escape-string (qof-print-date to-date-t64))))
(gnc:html-string-sanitize (qof-print-date from-date-t64))
(gnc:html-string-sanitize (qof-print-date to-date-t64))))
(gnc:html-barchart-set-width! chart width)
(gnc:html-barchart-set-height! chart height)
@ -560,8 +555,8 @@ developing over time"))
(if do-intervals?
(_ "~a to ~a")
(_ "Balances ~a to ~a"))
(jqplot-escape-string (qof-print-date from-date-t64))
(jqplot-escape-string (qof-print-date to-date-t64))))
(gnc:html-string-sanitize (qof-print-date from-date-t64))
(gnc:html-string-sanitize (qof-print-date to-date-t64))))
(gnc:html-linechart-set-width! chart width)
(gnc:html-linechart-set-height! chart height)

View File

@ -30,7 +30,6 @@
(use-modules (gnucash utilities))
(use-modules (srfi srfi-1))
(use-modules (ice-9 regex))
(use-modules (gnucash gnc-module))
(use-modules (gnucash gettext))

View File

@ -37,10 +37,6 @@
(gnc:module-load "gnucash/report/report-system" 0)
;; included since Bug726449
(use-modules (ice-9 regex)) ;; for regexp-substitute/global, used by jpqplot
(load-from-path "html-jqplot") ;; for jqplot-escape-string
(define reportname (N_ "Income/Expense Chart"))
(define optname-from-date (N_ "Start Date"))
@ -334,8 +330,8 @@
(gnc:html-barchart-set-subtitle!
chart (format #f
(_ "~a to ~a")
(jqplot-escape-string (qof-print-date from-date-t64))
(jqplot-escape-string (qof-print-date to-date-t64))))
(gnc:html-string-sanitize (qof-print-date from-date-t64))
(gnc:html-string-sanitize (qof-print-date to-date-t64))))
(gnc:html-barchart-set-width! chart width)
(gnc:html-barchart-set-height! chart height)
(gnc:html-barchart-set-row-labels! chart date-string-list)

View File

@ -49,7 +49,7 @@
(let ((chart (gnc:make-html-barchart))
(text (gnc:make-html-text (gnc:html-markup-p "[bar goes here]"))))
(gnc:html-barchart-set-title! chart "Bar Chart Title")
(gnc:html-barchart-set-subtitle! chart (jqplot-escape-string "Bar Chart SubTitle"))
(gnc:html-barchart-set-subtitle! chart (gnc:html-string-sanitize "Bar Chart SubTitle"))
(gnc:html-barchart-append-row! chart '(25 45 30))
(gnc:html-barchart-append-row! chart '(75 55 70))
(gnc:html-barchart-set-width! chart 320)