Database resources, that can be accessed from webpage that I'm currently working on, have unique id number with auto_increment set. So url would have to look like some.web.page.com/resource/id-number.
It would be kinda easy for user to notice that he can simply increase or decrease number at the end to get anything he pleases and while security isn't big concern in this case, I would really like to prevent that kind of behavior.
I was trying to find some function that would convert the number to random string look-a-like, but I failed (didn't really know what to put in that field on google.com ;) ). I also have my own ideas, but I prefer to use method that is already working well somewhere. The function needs to be symmetrical so I can easily generate string, and get number from that string. Any advice?
Ray Morgan gives an algorithm and an implementation in PHP. The algorithm has a few nice properties, namely:
the algorithm is deterministic, i.e., always produces the same obfuscated string for a given numeric ID value.
the obfuscation is fully invertible, i.e., if you know (only) the obfuscated value, you can extract the underlying numeric ID
doesn't yield any recognizable patterns (such as simple increasing sequences of integers)
it can detect, whether an obfuscated ID string has been tampered with
The author itself explains the basic steps as follows
Create a random number ($segment1) based on a hash of $id.
Create a second random number ($segment2) based on a hash of $segment1.
Alter $segment2 by adding or subtracting the value of $id.
Make a third hash ($segment3) from $segment1 and the altered $segment2. This hash makes it possible to detect any alteration of the encoded ID.
Concatenate the three segments into a string,
and voilà – you have your obfuscated ID.
For those like me not comfortable with PHP, a working Common Lisp port of the algorithm could look like:
#-(and) (ql:quickload "ironclad")
#-(and) (ql:quickload "trivial-utf-8")
(defpackage "HASHID"
(:use "COMMON-LISP" "IRONCLAD" "TRIVIAL-UTF-8")
(:shadowing-import-from "COMMON-LISP" "NULL"))
(in-package "HASHID")
(defparameter +secret+ "Secret Password")
(defun sha1-hex-digest (string &optional (secret +secret+))
(let ((digest (make-digest :sha1)))
(update-digest digest (string-to-utf-8-bytes string))
(update-digest digest (string-to-utf-8-bytes secret))
(let* ((result (produce-digest digest))
(length (length result))
(char-length (* length 2))
(buffer (make-array char-length :element-type 'character))
(digits "0123456789ABCDEF"))
(loop
:with wp := 0
:for byte :across result
:do (setf (char buffer (prog1 wp (incf wp))) (char digits (ash byte -4)))
(setf (char buffer (prog1 wp (incf wp))) (char digits (logand byte 15)))
:finally (return buffer)))))
(defun obfuscate-id (identifier)
(let* ((segment-1 (subseq (sha1-hex-digest (format nil "~D" identifier)) 0 16))
(segment-2 (subseq (sha1-hex-digest (concatenate 'string segment-1)) 0 8))
(decimal (parse-integer segment-2 :radix 16))
(buried-id (if (< identifier decimal) (- decimal identifier) (+ decimal identifier)))
(new-segment-2 (format nil "~8,'0X" buried-id))
(segment-3 (subseq (sha1-hex-digest (concatenate 'string segment-1 new-segment-2)) 0 8)))
(concatenate 'string segment-1 new-segment-2 segment-3)))
(defun deobfuscate-id (string)
(let* ((segment-1 (subseq string 0 16))
(segment-2 (subseq string 16 24))
(segment-3 (subseq string 24))
(expected-2 (subseq (sha1-hex-digest segment-1) 0 8))
(expected-3 (subseq (sha1-hex-digest (concatenate 'string segment-1 segment-2)) 0 8)))
(and (string-equal segment-3 expected-3)
(let* ((v1 (parse-integer segment-2 :radix 16))
(v2 (parse-integer expected-2 :radix 16)))
(abs (- v1 v2))))))
Note, that the original implementation generated a base-64 encoded string from the obfuscated ID and used that as the actual value. I did omit this step here, but it should be simple to add, in particular, if your programming language of choice comes with base-64 support.
Related
Is there a coding system such that (encode-coding-string msg '??? t) would convert my message into a list of 32 bit integers?
The binary coding system converts well the message to 8 bit data, and I am aware that I could post-process it to convert the result into 32 bits. I'm just wondering if there is already a coding system that does this... :) #lazy
Ok, attempt number two.
I wrote a test generator snippet in python:
def make_test_2():
with open('test2.bin', 'wb') as f:
args = [1867, 1982]
for a in args:
f.write((a).to_bytes(4, byteorder='little'))
This is a pretty hacky (a couple of reverse calls etc). But, its only meant to be a quick and dirty prototype.
(defun read-int-list2 (filename)
(let ((result '())
(accumulator '())
(accum-count 0)
(accum-max 4))
(with-temp-buffer
(set-buffer-multibyte nil)
(setq buffer-file-coding-system 'binary) ;; find a way to set temporarily? not sure
(insert-file-contents-literally filename)
(while (< (point) (point-max))
(if (< accum-count accum-max)
(progn
(setq accumulator (cons (aref (buffer-substring-no-properties (point) (1+ (point))) 0) accumulator))
(setq accum-count (1+ accum-count))))
(if (>= accum-count accum-max) ;; four bytes accumulated, lets bundle
(progn
(let* ((s (reverse accumulator))
(e1 (elt s 0))
(e2 (elt s 1))
(e3 (elt s 2))
(e4 (elt s 3))
(val (logior (lsh e4 24) (lsh e3 16) (lsh e2 8) e1))) ;; assume little endian (intel, ARM)
;; (message (format "%x %x %x %x -> %d" e1 e2 e3 e4 val))
(setq result (cons val result))
(setq accum-count 0)
(setq accumulator '()))))
(forward-char)))
(reverse result)))
(read-int-list2 "test2.bin") ;; (1867 1982)
I only did the one test. So that needs improvement. In words:
accumulate 8 byte chars from the special temp buffer (special because binary/literal load)
once the bytes per integer count has been reached, merge the accumulated bytes into an integer by bit shifting (be aware some machines are big endian, I assume here little endian) the bytes into place.
dump merged into result list
reset the accumulator
go to step 1
i have no doubt there are many improvements, my lisp is rusty.
So I have my sample code down below:
(defvar answer 0)
(defvar response "")
(defun question ()
(write-line "Enter your question")
(setq response (read-line))
(if (eql (subseq response 0 2) 'Is)
(print "T")
(print "nil")
))
The basic premise is to identify if the question asked begins with the word is.
The line that I think is giving me problems is (if (eql (subseq response 0 2) 'Is). I have other programs that use eql, but for some reason this use is always returning false no matter the input. I have already spent 3 hours trying a few different variations of this code, but none have worked. Any help would be much appreciated.
What you probably want is
(string-equal (subseq response 0 2) 'Is)
string-equal compares strings ignoring the character case. Unlike string-equal the string= function compares strings accounting for character case. An equivalent using string= function would be
(string= (string-upcase (subseq response 0 2)) 'Is)
Contrary to string comparison predicates the eql predicate compares lisp objects. For equal constant strings in compiled code it is likely to return true while in your case where one object is quoted literal and another object is computed character string it would fail.
For example (eql 'is 'is) returns true while (eql "is" "is") is false in interpreted code.
I'm in the process of reading a flat file - to use the characters read I want to convert them into numbers. I wrote a little function that converts a string to a vector:
(defun string-to-vec (strng)
(setf strng (remove #\Space strng))
(let ((vec (make-array (length strng))))
(dotimes (i (length strng) vec)
(setf (svref vec i) (char strng i)))))
However this returns a vector with character entries. Short of using char-code to convert unit number chars to numbers in a function, is there a simple way to read numbers as numbers from a file?
In addition to Rainer's answer, let me mention read-from-string (note that Rainer's code is more efficient than repeated application of read-from-string because it only creates a stream once) and parse-integer (alas, there is no parse-float).
Note that if you are reading a CSV file, you should probably use an off-the-shelf library instead of writing your own.
Above is shorter:
? (map 'vector #'identity (remove #\Space "123"))
#(#\1 #\2 #\3)
You can convert a string:
(defun string-to-vector-of-numbers (string)
(coerce
(with-input-from-string (s string)
(loop with end = '#:end
for n = (read s nil end)
until (eql n end)
unless (numberp n) do (error "Input ~a is not a number." n)
collect n))
'vector))
But it would be easier to read the numbers directly form the file. Use READ, which can read numbers.
Note that read-like functions are affected by reader macros.
Pick an example:
* (defvar *foo* 'bar)
*FOO*
* (read-from-string "#.(setq *foo* 'baz)")
BAZ
19
* *foo*
BAZ
As you can see read-from-string can implicitly set a variable. You can disable the #. reader macro by setting *read-eval* to nil but anyway if you have only integers on the input then consider using parse-integer instead.
How can I remove a certain character from a string in Nyquist (which is very similar to xlisp) and have the result returned?
I want to count how many "A" there are in a string like "ABBAAAABBBAABAAAB". (Yes, there are only 'A's and 'B's in the string.)
Since there is no (count) function in Nyquist I tried something like
(length (remove #\B mystring))
or
(length (remove #\B mystring :test equal))
But it doesn't work.
Forgetting the character count for a moment, how can I remove the 'B's from the string?
Will there always be only As and Bs in the string? If not, you might want to do something like
(remove #\A yourstring :test-not 'char=)
According to the XLISP reference for remove, the Nyquist remove doesn't deal with strings, only lists. You need to convert a string to a list in order to operate on it this way, but there's no coerce either. It's a touch hacky, but the easiest way around it I see is to stream a string and read-char it. This will produce a list of chars that you can then manipulate with remove.
(defun string->list (a-string)
(let ((collector nil)
(stream (make-string-input-stream a-string)))
(dotimes (c (length a-string) (reverse collector))
(setf collector (cons (read-char stream) collector)))))
It should now be possible to
(remove #\A (string->list yourstring) :test-not 'char=)
I see this is an old question, but since it has over 800 views, it's perhaps worth having the simple answer:
(defun remove-char (character sequence)
(let ((out ""))
(dotimes (i (length sequence) out)
(setf ch (char sequence i))
(unless (char= ch character)
(setf out (format nil "~a~a" out ch))))))
(setf mystring "ABBAABABCCCCBBCCCCAAA")
(remove-char #\B mystring) ;returns "AAAACCCCCCCCAAA"
Is there some function similar to PHP's str_replace in Common Lisp?
http://php.net/manual/en/function.str-replace.php
There is a library called cl-ppcre:
(cl-ppcre:regex-replace-all "qwer" "something to qwer" "replace")
; "something to replace"
Install it via quicklisp.
I think there is no such function in the standard. If you do not want to use a regular expression (cl-ppcre), you could use this:
(defun string-replace (search replace string &optional count)
(loop for start = (search search (or result string)
:start2 (if start (1+ start) 0))
while (and start
(or (null count) (> count 0)))
for result = (concatenate 'string
(subseq (or result string) 0 start)
replace
(subseq (or result string)
(+ start (length search))))
do (when count (decf count))
finally (return-from string-replace (or result string))))
EDIT: Shin Aoyama pointed out that this does not work for replacing, e.g., "\"" with "\\\"" in "str\"ing". Since I now regard the above as rather cumbersome I should propose the implementation given in the Common Lisp Cookbook, which is much better:
(defun replace-all (string part replacement &key (test #'char=))
"Returns a new string in which all the occurences of the part
is replaced with replacement."
(with-output-to-string (out)
(loop with part-length = (length part)
for old-pos = 0 then (+ pos part-length)
for pos = (search part string
:start2 old-pos
:test test)
do (write-string string out
:start old-pos
:end (or pos (length string)))
when pos do (write-string replacement out)
while pos)))
I especially like the use of with-output-to-string, which generally performs better than concatenate.
If the replacement is only one character, which is often the case, you can use substitute:
(substitute #\+ #\Space "a simple example") => "a+simple+example"