Many small fixes, added preliminary poll option in posts (admin only …

…for now)
newlisponrockets · Mar 22, 2013 · 7863152 · 7863152
1 parent e359846
commit 7863152
Show file tree

Hide file tree

Showing 9 changed files with 287 additions and 20 deletions.
diff --git a/log-to-database.lisp b/log-to-database.lisp
@@ -1,15 +1,221 @@
-#!/usr/bin/env newlisp
-
-(load "newlisp-rockets.lisp") ; this is where the magic happens!
-
 ; Access log -> Database script log-to-database.lisp
 ; 
 ; This script copies everything in /var/log/apache2/access.log into a database
 ; which can be queried later.
 ; 
 ; Written 2012 by Rocket Man
 
-(display-header "The newLISP on Rockets Blog")
+(module "sqlite3.lsp") ; loads the SQLite3 database module
+
+; FUNCTIONS-------------------------------------------------
+
+(define (displayln str-to-display)
+ 	(println str-to-display)	
+)
+
+;; Function: (open-database)
+;; Usage: (open-database "database name")
+;; Returns: Opens a SQLite3 database.  A ".db" extension will be added automatically to the name.
+;; Note: Only one database can be open at a time.  You will need to close one database to open another.
+;-----------------------------------------------------------------------------------------------------
+(define (open-database sql-db-to-open)
+	(if (sql3:open (string sql-db-to-open ".db"))  
+		(displayln "")
+		(displayln "There was a problem opening the database " sql-db-to-open ": " (sql3:error))))
+
+;; Function: (close-database)
+;; Usage: (open-database)
+;; Returns: Closes the currently open database.
+;-----------------------------------------------------------------------------------------------------
+(define (close-database)
+	(if (sql3:close)
+		(displayln "")
+		(displayln "There was a problem closing the database: " (sql3:error))))
+
+;====== SAFE-FOR-SQL ===============================================================
+; this function makes strings safe for inserting into SQL statements
+; to avoid SQL injection issues
+; it's simple right now but will add to it later
+;===================================================================================
+(define (safe-for-sql str-sql-query)
+	(if (string? str-sql-query) (begin
+		(replace "&" str-sql-query "&amp;")
+		(replace "'" str-sql-query "&apos;")
+		(replace "\"" str-sql-query "&quot;")
+		))
+		(set 'result str-sql-query))
+
+;; Function: (query)
+;; Usage: (query "SQL text")
+;; This function sends a straight SQL query to the currently open database
+(define (query sql-text)
+ (set 'sqlarray (sql3:sql sql-text))    ; results of query
+ (if sqlarray
+   (setq query-return sqlarray)
+		(if (sql3:error)
+			(displayln (sql3:error) " query problem ")
+			(setq query-return nil))))
+
+;; Function: (create-record) 
+;; Usage: (create-record "Table Name" ColumnName1 ColumnName2 ColumnName3 ...)
+;; Returns: true if creation was successful, otherwise displays the SQL error
+;; The way this works it that your variable names need to be the same as the column names
+;; in the database.  Enforcing this makes the code simpler and easier to read.  Set the values
+;; before calling (create-record).  When it is called, the values of each column will be set in a 
+;; new record in the database.
+;; Note: Variables need to be either integers or strings, depending on the type of column.
+;; Note: Date columns need to be strings using the SQL Date format: "YYYY-MM-DD HH:MM:SS.000"
+;-----------------------------------------------------------------------------------------------------
+(define-macro (create-record)
+	; first save the values
+	(set 'temp-record-values nil)
+	(set 'temp-table-name (first (args)))
+	;(displayln "<BR>Arguments: " (args))
+	(dolist (s (rest (args))) (push (eval s) temp-record-values -1))
+	; now save the arguments as symbols under the context "DB"
+	(dolist (s (rest (args)))
+		(set 'temp-index-num (string $idx)) ; we need to number the symbols to keep them in the correct order
+		(if (= (length temp-index-num) 1) (set 'temp-index-num (string "0" temp-index-num))) ; leading 0 keeps the max at 100.
+		(sym (string temp-index-num s) 'DB))
+	; now create the sql query 
+	(set 'temp-sql-query (string "INSERT INTO " temp-table-name " ("))
+	;(displayln "<P>TABLE NAME: " temp-table-name)
+	;(displayln "<P>SYMBOLS: " (symbols DB))
+	;(displayln "<BR>VALUES: " temp-record-values)
+	(dolist (d (symbols DB)) (extend temp-sql-query (rest (rest (rest (rest (rest (string d)))))) ", "))
+	(set 'temp-sql-query (chop (chop temp-sql-query)))
+	(extend temp-sql-query ") VALUES (")
+	(dolist (q temp-record-values)
+		(if (string? q) (extend temp-sql-query "'")) ; only quote if value is non-numeric
+		(extend temp-sql-query (string (safe-for-sql q)))
+		(if (string? q) (extend temp-sql-query "'")) ; close quote if value is non-numeric
+		(extend temp-sql-query ", ")) ; all values are sanitized to avoid SQL injection
+	(set 'temp-sql-query (chop (chop temp-sql-query)))
+	(extend temp-sql-query ");")
+	;(displayln "<p>***** SQL QUERY: " temp-sql-query)
+	(displayln (query temp-sql-query)) ; actually run the query against the database
+	(delete 'DB) ; we're done, so delete all symbols in the DB context.
+)	
+
+;; Function: (update-record) 
+;; Usage: (update-record "Table Name" ConditionColumn ColumnName1 ColumnName2 ColumnName3 ...)
+;; Returns: true if update was successful, otherwise displays the SQL error
+;; The way this works it that your variable names need to be the same as the column names
+;; in the database.  Enforcing this makes the code simpler and easier to read.  Set the values
+;; before calling (update-record).  When it is called, the values of each column will be set to those values.
+;; Note: The variable "ConditionColumn" will check to see if the column equals that value
+;; Example: (update-record "Posts" Id Subject Content) will update the Subject and Content columns
+;; for all records where Id is equal to the value of the variable Id.
+;; Note: Variables need to be either integers or strings, depending on the type of column.
+;; Note: Date columns need to be strings using the SQL Date format: "YYYY-MM-DD HH:MM:SS.000"
+;-----------------------------------------------------------------------------------------------------
+(define-macro (update-record)
+	; first save the values
+	(set 'temp-record-values nil)
+	(set 'temp-table-name (first (args)))
+	(set 'continue true) ; debugging
+	(dolist (s (rest (args))) (push (eval s) temp-record-values -1))
+	; now save the arguments as symbols under the context "D2"
+	(dolist (st (rest (args)))
+		(set 'temp-index-num (string $idx)) ; we need to number the symbols to keep them in the correct order
+		(if (= (length temp-index-num) 1) (set 'temp-index-num (string "0" temp-index-num))) ; leading 0 keeps the max at 100.
+		;(displayln "<br>SYMBOL>>>>" (string temp-index-num st) "<<<") ; debugging
+		(sym (string temp-index-num st) 'D2)
+	)
+	(if continue (begin ; --- temporary debugging
+	; now create the sql query 
+	(set 'temp-sql-query (string "UPDATE " temp-table-name " SET "))
+	;(displayln "<P>TABLE NAME: " temp-table-name)
+	;(displayln "<P>SYMBOLS: " (symbols D2))
+	;(displayln "<BR>VALUES: " temp-record-values)
+	(dolist (d (rest (symbols D2))) ; ignore the first argument, as it will be the ConditionColumn for later
+		(extend temp-sql-query (rest (rest (rest (rest (rest (string d)))))) "=")
+		(set 'q (temp-record-values (+ $idx 1)))
+		(if (string? q) (extend temp-sql-query "'")) ; only quote if value is non-numeric
+		(extend temp-sql-query (string (safe-for-sql q)))
+		(if (string? q) (extend temp-sql-query "'")) ; close quote if value is non-numeric
+		(extend temp-sql-query ", ") ; all values are sanitized to avoid SQL injection
+	)	
+	(set 'temp-sql-query (chop (chop temp-sql-query)))
+	; okay now add the ConditionColumn value
+	(extend temp-sql-query (string " WHERE " (rest (rest (rest (rest (rest (string (first (symbols D2)))))))) "="))
+	(if (string? (first temp-record-values)) (extend temp-sql-query "'"))
+	(extend temp-sql-query (string (safe-for-sql (first temp-record-values))))
+	(if (string? (first temp-record-values)) (extend temp-sql-query "'"))
+	(extend temp-sql-query ";")
+	;(displayln "<p>***** SQL QUERY: " temp-sql-query)
+	(query temp-sql-query) ; actually run the query against the database
+	(delete 'D2) ; we're done, so delete all symbols in the DB context.
+	)) ; --- end temporary debugging
+)	
+
+;; Function: (delete-record) 
+;; Usage: (delete-record "Table Name" ColumnName1)
+;; Returns: true if deletion was successful, otherwise displays the SQL error
+;; The variable ColumnName1 needs to be assigned a value that will be checked to qualify the deletion
+;; Example: (set 'Email "bob@bob.com") (delete-record "Posts" Email) will delete all records where
+;; the column name "Email" is equal to "bob@bob.com".  
+;; Note: Variables need to be either integers or strings, depending on the type of column.
+;; Note: Date columns need to be strings using the SQL Date format: "YYYY-MM-DD HH:MM:SS.000"
+;-----------------------------------------------------------------------------------------------------
+(define-macro (delete-record)
+	(set 'temp-table-name (first (args)))
+	(set 'temp-record-values nil)
+	(dolist (s (rest (args))) (push (eval s) temp-record-values -1)) ; only one value for NOW...
+	(sym (first (rest (args))) 'DB) ; put the second argument (for now) into a symbol in the DB context
+												; this will have to be in a dolist loop of (rest (args)) when I add more
+	(set 'temp-sql-query (string "DELETE FROM " temp-table-name " WHERE "))
+	(dolist (d (symbols DB)) (extend temp-sql-query (rest (rest (rest (string d))))))
+	(extend temp-sql-query "=")
+	; why am I doing a loop here?  There should be only one value, right?  But maybe for future extension...
+	(dolist (q temp-record-values)
+		(if (string? q) (extend temp-sql-query "'")) ; only quote if value is non-numeric
+		(extend temp-sql-query (string (safe-for-sql q)))
+		(if (string? q) (extend temp-sql-query "'"))) ; close quote if value is non-numeric
+	(extend temp-sql-query ";")
+	;(displayln "TEMP-DELETE-QUERY: " temp-sql-query)	
+	(query temp-sql-query)
+	(delete 'DB) ; we're done, so delete all symbols in the DB context.
+)
+
+;; Function: (get-record) 
+;; Usage: (get-record "Table Name" ColumnName1)
+;; Returns: A list of all values for the record if successful, otherwise displays the SQL error
+;; The variable ColumnName1 needs to be assigned a value that will be checked to qualify the query
+;; Example: (set 'Email "bob@bob.com") (get-record "Posts" Email) will retrieve all records where
+;; the column name "Email" is equal to "bob@bob.com".  
+;; Note: Variables need to be either integers or strings, depending on the type of column.
+;; Note: Date columns need to be strings using the SQL Date format: "YYYY-MM-DD HH:MM:SS.000"
+;-----------------------------------------------------------------------------------------------------
+(define-macro (get-record)
+	(set 'temp-table-name (first (args)))
+	; if you have more arguments than just the table name, they become the elements of the WHERE clause
+	(if (> (length (args)) 1) (begin
+		(set 'temp-record-values nil)
+		(dolist (s (rest (args))) (push (eval s) temp-record-values -1)) ; only one value for NOW...
+		(sym (first (rest (args))) 'DB) ; put the second argument (for now) into a symbol in the DB context
+													; this will have to be in a dolist loop of (rest (args)) when I add more
+		(set 'temp-sql-query (string "SELECT * FROM " temp-table-name " WHERE "))
+		(dolist (d (symbols DB)) (extend temp-sql-query (rest (rest (rest (string d))))))
+		(extend temp-sql-query "=")
+		; why am I doing a loop here?  There should be only one value, right?  But maybe for future extension...
+		(dolist (q temp-record-values)
+			(if (string? q) (extend temp-sql-query "'")) ; only quote if value is non-numeric
+			(extend temp-sql-query (string (safe-for-sql q)))
+			(if (string? q) (extend temp-sql-query "'"))) ; close quote if value is non-numeric
+		(extend temp-sql-query ";")
+	)
+		; otherwise, just get everything in that table
+		(set 'temp-sql-query (string "SELECT * FROM " temp-table-name ";"))
+	)
+	;(displayln "TEMP-GET-QUERY: " temp-sql-query)	
+	(delete 'DB) ; we're done, so delete all symbols in the DB context.
+	(set 'return-value (query temp-sql-query)) ; this returns a list of everything in the record
+)
+
+; END FUNCTIONS ===================
+
+
 (open-database "SERVER-LOGS")
 (query "CREATE TABLE Logs (Id INTEGER PRIMARY KEY, IP TEXT, UserId TEXT, UserName TEXT, Date DATE, Request TEXT, Result TEXT, Size INTEGER, Referrer TEXT, UserAgent TEXT)")
 ;(print (query "SELECT * from SQLITE_MASTER;"))
@@ -24,14 +230,16 @@
 	;(println "Length of line: " (length line-list))
 	(if (> (length line-list) 0) (begin
 		(++ max-items)
-		(set 'Id max-items) (print Id "/" (length access-list))
+		(set 'Id max-items) (print $idx "/" (length access-list))
 		(set 'IP (string (line-list 0) (line-list 1) (line-list 2))) 
 		(set 'UserId (line-list 3))
 		(set 'UserName (line-list 4))
 		(set 'Date (line-list 5))
 		(set 'Date (trim Date "["))
-		(set 'Date (trim Date "]"))
-		(set 'date-parsed (date-parse Date "%d/%b/%Y:%H:%M:%S -0800"))
+		(set 'Date (trim Date "]")) 
+		;(println "DATE: " Date) 
+		(set 'date-parsed (date-parse Date "%d/%b/%Y:%H:%M:%S -0700"))
+		;(println "DATE-PARSED: " date-parsed)
 		(set 'Date (date date-parsed 0 "%Y-%m-%dT%H:%M:%S"))
 		(println " " Date)
 		(set 'Request (line-list 6))

diff --git a/newlisp-rockets.lisp b/newlisp-rockets.lisp
@@ -32,7 +32,7 @@
 
 ;!===== GLOBAL VARIABLES ========================================================
 ;;* $ROCKETS_VERSION - current version of Rockets
-(constant (global '$ROCKETS_VERSION) 0.36)    
+(constant (global '$ROCKETS_VERSION) 0.41)    
 ;;* $MAX_POST_LENGTH - maximum size of data you are allowed to POST
 (constant (global '$MAX_POST_LENGTH) 83886080) 
 ;;* $BASE_PATH - the absolute path for the installation (default is /)
@@ -171,7 +171,7 @@
 	(replace "<" str-input-for-web "&lt;")
 	(replace ">" str-input-for-web "&gt;")
 	; but we need a way to do bold and italics at least, so let's do that, and images
-	(set 'ubb-code-list '("i" "b" "u" "code" "pre"))
+	(set 'ubb-code-list '("i" "b" "u" "code" "pre" "h1" "h2" "h3" "h4"))
 	(dolist (u ubb-code-list)
 		(replace (string "[" u "]") str-input-for-web (string "<" u ">"))
 		(replace (string "[" (upper-case u) "]") str-input-for-web (string "<" u ">"))
@@ -189,6 +189,10 @@
 	(replace "[YOUTUBE]" str-input-for-web "<iframe width=\"560\" height=\"315\" src=\"http://www.youtube.com/embed/")
 	(replace "[/youtube]" str-input-for-web "\" frameborder=\"0\" allowfullscreen></iframe>")
 	(replace "[/YOUTUBE]" str-input-for-web "\" frameborder=\"0\" allowfullscreen></iframe>")
+	(replace "[radio]" str-input-for-web "<input type='radio' name=")
+	(replace "[/radio]" str-input-for-web ">")
+	(replace "[poll]" str-input-for-web "<form name=poll method=POST action=rockets-poll.lsp>")
+	(replace "[/poll]" str-input-for-web "<br><br><input type=submit value='Vote'></form>")
 	; replace line breaks with HTML line breaks
 	(replace "\r\n" str-input-for-web "<BR>")
 )
@@ -774,7 +778,7 @@
 ;! ===== FORM AND TABLE FUNCTIONS =========================================================================
 
 ;; Function: (display-post-box)
-;; Usage: (display-post-box "Title" "Form Name" "page-to-submit" "Subject Line ID" "Postbox ID" "Submit Button Text" "optional linkback value" "optional text to pre-populate subject line" "optional text to pre-populate post box" "optional hidden value")
+;; Usage: (display-post-box "Title" "Form Name" "page-to-submit" "Subject Line ID" "Postbox ID" "Submit Button Text" "optional linkback value" "optional text to pre-populate subject line" "optional text to pre-populate post box" "optional hidden value" true)
 ;; Returns: Displays a form with a subject line and a text box, and a submit button.  
 ;; The form will enter information into POST and redirect to "page-to-submit.lsp" when Submit is clicked.
 ;; Note: The .lsp extension is optional.  If it is not entered, it will be added automatically.
@@ -785,8 +789,9 @@
 ;; If this becomes a trend, I might just turn hidden values into a list, which would be cleaner, but we'll leave it for now.
 ;; This is useful for when you want the page that is called via the submit button to remember the Id # of, for example,
 ;; which post you were editing or just added.
+;; Note: The final option "true" will add a poll option to the post box display.
 ;-----------------------------------------------------------------------------------------------------
-(define (display-post-box str-title str-form-name str-action-page str-subject-line str-postbox-id str-submit-button-text str-linkback-id str-optional-subject-value str-optional-post-value str-optional-hidden-value)
+(define (display-post-box str-title str-form-name str-action-page str-subject-line str-postbox-id str-submit-button-text str-linkback-id str-optional-subject-value str-optional-post-value str-optional-hidden-value bool-poll-option)
 	(displayln "<h3>" str-title "</h3>")
 	(if (not (find ".lsp" str-action-page)) (extend str-action-page ".lsp"))
 	(displayln "<form name='" str-form-name "' METHOD='POST' action='" str-action-page "'>")
@@ -803,6 +808,11 @@
 	; now add the two hidden values, if they exist
 	(if str-linkback-id (displayln "<input type='hidden' name='linkbackid' value='" str-linkback-id "'>"))
 	(if str-optional-hidden-value (displayln "<input type='hidden' name='optionalhidden' value='" str-optional-hidden-value "'>"))
+	(if bool-poll-option (begin
+		(displayln "<br>Add a poll option:")
+		(displayln "<br><br>Poll topic (leave blank for no poll): <input type=text' id='polltopic' name='polltopic' class='span4'>")
+		(displayln "<br><br>Poll options (one for each line): <textarea name='pollvalues' id='pollvalues' class='field span7' rows='5'></textarea>")
+	))
 	(displayln "<br><p><input type='submit' class='btn' value='" str-submit-button-text "'>")
 	(displayln "</form>"))
 
@@ -883,8 +893,8 @@
 
 		(displayln
 			"<div class='row-fluid'>"
-			"<h5>" tweet-text "</h5><br/>"
 			"<div class='thumbnail'>" (date dateseconds 0 "%a %d %b %Y %H:%M:%S") "</div><div class='author'>By&nbsp;" (lookup '(author name) entry) "</div><br/>"
+			"<h5>" tweet-text "</h5><br/>"
 			"</div>"
 		)
 	)

diff --git a/partials/rockets-checksignin.lsp b/partials/rockets-checksignin.lsp
@@ -1,5 +1,6 @@
 ; (rockets-checksignin.lsp)
 ;
+; MODIFIED FOR WRITINGHOLMES
 ; This is a partial file... all it does is check the validity of the user's sign-in cookie
 ; and if it is a valid cookie, retrieves the user data.  If it's not a valid cookie or the cookie
 ; isn't there, it simply doesn't set the appropriate variables
@@ -30,6 +31,7 @@
 		(set 'Rockets:UserEmail (load-user-sql-data 1))
 		(set 'Rockets:UserSalt (load-user-sql-data 3))
 		(set 'Rockets:UserPosts (load-user-sql-data 4))
+		(set 'Rockets:UserAchievements (load-user-sql-data 5))
 		(set 'Rockets:UserReadPosts (load-user-sql-data 6))
 		(if (nil? Rockets:UserReadPosts) (set 'Rockets:UserReadPosts "")) ; set blank if no data for read posts
 		(set 'Rockets:UserName (load-user-sql-data 7))
@@ -39,5 +41,9 @@
 		(if (and Rockets:UserBirthDate (= (length Rockets:UserBirthDate) 23)) ; change SQLite format to MM-DD-YYYY format
 			(set 'Rockets:UserBirthDate (string (slice Rockets:UserBirthDate 8 2) "-" (slice Rockets:UserBirthDate 5 2) "-" (slice Rockets:UserBirthDate 0 4))))
 		(if (nil? Rockets:UserAvatar) (set 'Rockets:UserAvatar "unknown.png"))
+		; set Admin flag if UserId=1 OR if Admin flag set in Achievements
+		(if (or (= Rockets:UserId 0) (find "A" Rockets:UserAchievements))
+			(set 'Rockets:IsUserAdmin true)
+			(set 'Rockets:IsUserAdmin nil))
 	))
-))
+))