From 33182646943245b1e41d8dfc73dc620811ff342c Mon Sep 17 00:00:00 2001 From: Marek Paśnikowski Date: Sun, 21 Jan 2024 00:34:21 +0100 Subject: Implement input sanitation To the best of my current ability, implement checks and guards on the given inputs. --- www/build-site.el | 66 ++++++++++++++++++++++++++++++++++---------- www/www-test-data.el | 12 ++++---- www/www.org | 78 +++++++++++++++++++++++++++++++++++++--------------- 3 files changed, 112 insertions(+), 44 deletions(-) diff --git a/www/build-site.el b/www/build-site.el index 92f6339..5f2e997 100644 --- a/www/build-site.el +++ b/www/build-site.el @@ -10,45 +10,81 @@ :object-compose ( lambda ( ) - ( setq org-publish-project-alist ( list object-projects ) ) - ( ) ) + ( setq org-publish-project-alist ( list object-projects ) ) ) :object-get-projects - ( lambda ( data-projects ) - ( setq object-projects ( append data-projects object-projects ) ) - ( ) ) + ( lambda ( project-data ) + ( setq object-projects ( append project-data object-projects ) ) ) :object-report ( lambda ( ) ( print org-publish-project-alist ) - ( print success-report ) - ( ) ) ) ) ) + ( print success-report ) ) ) ) ) ;;; The Object Interface ( defun object-compose ( publication-instance ) ( funcall ( plist-get publication-instance :object-compose ) ) ) -( defun object-get-projects ( publication-instance data-projects ) +( defun object-get-projects ( publication-instance project-data ) ( funcall - ( plist-get publication-instance :object-get-projects ) data-projects ) ) + ( plist-get publication-instance :object-get-projects ) project-data ) ) ( defun object-report ( publication-instance ) ( funcall ( plist-get publication-instance :object-report ) ) ) ;;; The User Logic +( defun atypical-header-p ( project-data ) + ( let ( ( element-1 ( pop project-data ) ) + ( element-2 ( pop project-data ) ) + ( error-1 "First element is not a string: " ) + ( error-2 "Second element is not a keyword: " ) ) + ( condition-case error + ( cond + ( ( not ( stringp element-1 ) ) + ( signal 'scan-error ( concat error-1 element-1 ) ) ) + ( ( not ( keywordp element-2 ) ) + ( signal 'scan-error ( concat error-2 element-2 ) ) ) ) + ( scan-error ( print ( cdr error ) ) ) ) ) ) + ( defun export-project-alist ( publication-instance ) ( object-compose publication-instance ) ( object-report publication-instance ) ) +( defun get-component ( project-data ) + ( let ( ( component ( nth 2 project-data ) ) ) + ( print component ) + component ) ) + +( defun has-component-p ( project-data ) + ( let ( ( component-keyword ':components ) + ( second ( nth 1 project-data ) ) ) + ( eq component-keyword second ) ) ) + ( defun import-data ( publication-instance project-data ) - ( let ( ( data-projects ( plist-get project-data :data-projects ) ) ) - ( object-get-projects publication-instance data-projects ) ) ) + ( object-get-projects publication-instance project-data ) ) + +( defun too-short-p ( project-data ) + ( let ( ( minimal-length 2 ) ) + ( < ( length project-data ) minimal-length ) ) ) ;;; The User Interface -( defun publish ( publication-instance &rest project-data ) - ( import-data publication-instance project-data ) - ( export-project-alist publication-instance ) - ( ) ) +( defun publish ( publication-instance &rest project-data-wrapped ) + ( let ( ( project-data ( car project-data-wrapped ) ) ) + ( pcase project-data + ( ( guard ( too-short-p project-data ) ) nil ) + ( ( guard ( atypical-header-p project-data ) nil ) ) + ( ( pred has-component-p project-data ) + ( let ( ( component ( get-component project-data ) ) + ( head ( nth 0 project-data ) ) + ( tail ( nthcdr 3 project-data ) ) ) + ( list + head + ( publish publication-instance component ) + ( publish publication-instance tail ) ) ) ) + ( _ + ( progn + ( import-data publication-instance project-data ) + ( export-project-alist publication-instance ) ) ) ) ) ) diff --git a/www/www-test-data.el b/www/www-test-data.el index f6ef8aa..ddafd01 100644 --- a/www/www-test-data.el +++ b/www/www-test-data.el @@ -5,15 +5,12 @@ ( print "publish-test-1" ) ( let ( ( publication-instance ( publication-object ) ) ) - ( publish publication-instance - :data-projects ( list "test.pl" "example.org" ) ) ) + ( publish publication-instance ( list "test.pl" "example.org" ) ) ) ( print "publish-test-2" ) ( let ( ( publication-instance ( publication-object ) ) ) ( publish publication-instance - - :data-projects ( list "test.pl" :property1 @@ -25,7 +22,8 @@ ( print "publish-test-3" ) ( let ( ( publication-instance ( publication-object ) ) ) - ( publish publication-instance "test.pl" + ( publish publication-instance + ( list "test.pl" - :components - ( list "example.pl" "example.org" ) ) ) + :components + ( list "example.pl" "example.org" )) ) ) diff --git a/www/www.org b/www/www.org index 40ef38b..e4432af 100644 --- a/www/www.org +++ b/www/www.org @@ -26,15 +26,12 @@ many other properties of a project. ( print "publish-test-1" ) ( let ( ( publication-instance ( publication-object ) ) ) - ( publish publication-instance - :data-projects ( list "test.pl" "example.org" ) ) ) + ( publish publication-instance ( list "test.pl" "example.org" ) ) ) ( print "publish-test-2" ) ( let ( ( publication-instance ( publication-object ) ) ) ( publish publication-instance - - :data-projects ( list "test.pl" :property1 @@ -46,10 +43,11 @@ many other properties of a project. ( print "publish-test-3" ) ( let ( ( publication-instance ( publication-object ) ) ) - ( publish publication-instance "test.pl" + ( publish publication-instance + ( list "test.pl" - :components - ( list "example.pl" "example.org" ) ) ) + :components + ( list "example.pl" "example.org" )) ) ) #+END_SRC *** [[https://orgmode.org/manual/Project-alist.html][The variable =org-publish-project-alist=]] @@ -90,48 +88,84 @@ are also published, in the sequence given. :object-compose ( lambda ( ) - ( setq org-publish-project-alist ( list object-projects ) ) - ( ) ) + ( setq org-publish-project-alist ( list object-projects ) ) ) :object-get-projects - ( lambda ( data-projects ) - ( setq object-projects ( append data-projects object-projects ) ) - ( ) ) + ( lambda ( project-data ) + ( setq object-projects ( append project-data object-projects ) ) ) :object-report ( lambda ( ) ( print org-publish-project-alist ) - ( print success-report ) - ( ) ) ) ) ) + ( print success-report ) ) ) ) ) ;;; The Object Interface ( defun object-compose ( publication-instance ) ( funcall ( plist-get publication-instance :object-compose ) ) ) - ( defun object-get-projects ( publication-instance data-projects ) + ( defun object-get-projects ( publication-instance project-data ) ( funcall - ( plist-get publication-instance :object-get-projects ) data-projects ) ) + ( plist-get publication-instance :object-get-projects ) project-data ) ) ( defun object-report ( publication-instance ) ( funcall ( plist-get publication-instance :object-report ) ) ) ;;; The User Logic + ( defun atypical-header-p ( project-data ) + ( let ( ( element-1 ( pop project-data ) ) + ( element-2 ( pop project-data ) ) + ( error-1 "First element is not a string: " ) + ( error-2 "Second element is not a keyword: " ) ) + ( condition-case error + ( cond + ( ( not ( stringp element-1 ) ) + ( signal 'scan-error ( concat error-1 element-1 ) ) ) + ( ( not ( keywordp element-2 ) ) + ( signal 'scan-error ( concat error-2 element-2 ) ) ) ) + ( scan-error ( print ( cdr error ) ) ) ) ) ) + ( defun export-project-alist ( publication-instance ) ( object-compose publication-instance ) ( object-report publication-instance ) ) + ( defun get-component ( project-data ) + ( let ( ( component ( nth 2 project-data ) ) ) + ( print component ) + component ) ) + + ( defun has-component-p ( project-data ) + ( let ( ( component-keyword ':components ) + ( second ( nth 1 project-data ) ) ) + ( eq component-keyword second ) ) ) + ( defun import-data ( publication-instance project-data ) - ( let ( ( data-projects ( plist-get project-data :data-projects ) ) ) - ( object-get-projects publication-instance data-projects ) ) ) + ( object-get-projects publication-instance project-data ) ) + + ( defun too-short-p ( project-data ) + ( let ( ( minimal-length 2 ) ) + ( < ( length project-data ) minimal-length ) ) ) ;;; The User Interface - ( defun publish ( publication-instance &rest project-data ) - ( import-data publication-instance project-data ) - ( export-project-alist publication-instance ) - ( ) ) + ( defun publish ( publication-instance &rest project-data-wrapped ) + ( let ( ( project-data ( car project-data-wrapped ) ) ) + ( pcase project-data + ( ( guard ( too-short-p project-data ) ) nil ) + ( ( guard ( atypical-header-p project-data ) nil ) ) + ( ( pred has-component-p project-data ) + ( let ( ( component ( get-component project-data ) ) + ( head ( nth 0 project-data ) ) + ( tail ( nthcdr 3 project-data ) ) ) + ( list + head + ( publish publication-instance component ) + ( publish publication-instance tail ) ) ) ) + ( _ + ( progn + ( import-data publication-instance project-data ) + ( export-project-alist publication-instance ) ) ) ) ) ) #+END_SRC * EOF -- cgit v1.2.3