Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Zach Beane
zacl
Commits
bcfee1e7
Commit
bcfee1e7
authored
Oct 17, 2018
by
Dave Cooper
Browse files
Replaced base64 code with functions from :cl-base64 library.
parent
9e668d38
Changes
2
Hide whitespace changes
Inline
Side-by-side
package-excl.lisp
View file @
bcfee1e7
...
...
@@ -546,127 +546,17 @@ values otherwise."
;;; BASE64
(
defun
excl:base64-string-to-string
(
string
)
;;
;; given a base64 string, return it decoded.
;; beware: the result will not be a simple string
;;
(
let
((
res
(
make-array
(
length
string
)
:element-type
'character
:fill-pointer
0
:adjustable
t
))
(
arr
*base64-decode*
))
(
declare
(
type
(
simple-array
(
unsigned-byte
8
)
(
128
))
arr
))
(
do
((
i
0
(
+
i
4
))
(
cha
)
(
chb
))
((
>=
i
(
length
string
)))
; for multiline decoding, ignore cr and lfs
(
loop
(
let
((
ch
(
char
string
i
)))
(
if*
(
or
(
eq
ch
#\linefeed
)
(
eq
ch
#\return
))
then
(
incf
i
)
(
if*
(
>=
i
(
length
string
))
then
(
return-from
excl:base64-string-to-string
))
else
(
return
))))
(
let
((
val
(
+
(
ash
(
aref
arr
(
char-code
(
char
string
i
)))
18
)
(
ash
(
aref
arr
(
char-code
(
char
string
(
+
i
1
))))
12
)
(
ash
(
aref
arr
(
char-code
(
setq
cha
(
char
string
(
+
i
2
)))))
6
)
(
aref
arr
(
char-code
(
setq
chb
(
char
string
(
+
i
3
))))))))
(
vector-push-extend
(
code-char
(
ash
val
-16
))
res
)
;; when the original size wasn't a mult of 3 there may be
;; non-characters left over
(
if*
(
not
(
eq
cha
#\=
))
then
(
vector-push-extend
(
code-char
(
logand
#xff
(
ash
val
-8
)))
res
))
(
if*
(
not
(
eq
chb
#\=
))
then
(
vector-push-extend
(
code-char
(
logand
#xff
val
))
res
))))
res
))
(
defun
excl:nbase64-string-to-string
(
string
)
(
cl-base64:base64-string-to-string
string
))
(
defun
excl:string-to-base64-string
(
str
)
;;
;; take the given string and encode as a base64 string
;; beware: the result will not be a simple string
;;
(
let
((
output
(
make-array
(
ceiling
(
*
1.3
(
length
str
)))
:element-type
'character
:fill-pointer
0
:adjustable
t
))
v1
v2
v3
eol
(
from
0
)
(
max
(
length
str
))
)
(
loop
(
if*
(
>=
from
max
)
then
(
return
))
(
setq
v1
(
char-code
(
schar
str
from
)))
(
incf
from
)
(
if*
(
>=
from
max
)
then
(
setq
v2
0
eol
t
)
else
(
setq
v2
(
char-code
(
schar
str
from
))))
(
incf
from
)
; put out first char of encoding
(
vector-push-extend
(
schar
*base64-encode*
(
logand
#x3f
(
ash
v1
-2
)))
output
)
; put out second char of encoding
(
vector-push-extend
(
schar
*base64-encode*
(
+
(
ash
(
logand
3
v1
)
4
)
(
logand
#xf
(
ash
v2
-4
))))
output
)
(
if*
eol
then
; two pads
(
vector-push-extend
#\=
output
)
(
vector-push-extend
#\=
output
)
(
return
))
(
if*
(
>=
from
max
)
then
(
setq
v3
0
eol
t
)
else
(
setq
v3
(
char-code
(
schar
str
from
))))
(
incf
from
)
; put out third char of encoding
(
vector-push-extend
(
schar
*base64-encode*
(
+
(
ash
(
logand
#xf
v2
)
2
)
(
logand
3
(
ash
v3
-6
))))
output
)
(
if*
eol
then
(
vector-push-extend
#\=
output
)
(
return
))
; put out fourth char of encoding
(
vector-push-extend
(
schar
*base64-encode*
(
logand
#x3f
v3
))
output
))
output
))
(
cl-base64:string-to-base64-string
str
:columns
52
))
;;; Microtime
(
defconstant
excl::base-for-internal-real-time
-455615030
)
(
defun
excl::acl-internal-real-time
()
(
values
(
-
(
get-universal-time
)
4165516800
)
(
/
(
local-time:nsec-of
(
local-time:now
))
1000
)))
zacl.asd
View file @
bcfee1e7
...
...
@@ -20,7 +20,8 @@
#:alexandria
#:md5
#:cl+ssl
#:local-time
)
#:local-time
#:cl-base64
)
:serial
t
:components
((
:file
"package"
)
#+
clozure
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment