I've tried to replace SBCL with Clozure CL when working in IPv6 only network, but encountered an error like that:
MIGRATIONS> (ignore-errors (ccl:make-socket :remote-host "ya.ru" :remote-port 443))
NIL
#<CCL:NO-APPLICABLE-METHOD-EXISTS #x302005215E5D>
MIGRATIONS> (ignore-errors (ccl:make-socket :remote-host "ya.ru" :remote-port 443 :address-family :internet))
NIL
#<CCL:NO-APPLICABLE-METHOD-EXISTS #x3020052549AD>
MIGRATIONS> (ignore-errors (ccl:make-socket :remote-host "ya.ru" :remote-port 443 :address-family :internet6))
#<BASIC-TCP-STREAM ISO-8859-1 (SOCKET/16) #x3020051D4A9D>
The problem is that many libraries when using CCL:MAKE-TCP-SOCKET don't specify address-family or specify an :internet.
Is there is a way to patch ccl:make-socket at runtime to override this setting?
Advise a function
Several implementations of Common Lisp allow advising (-> patching) of normal functions. Advising is a non-standard feature and different implementations provide it in slightly different ways. A related mechanism is standardized for CLOS generic functions with :before, :after and :around methods.
The purpose is to add one or more patches to a function, after it has been defined and without altering the original source code.
Typically this requires that the function call to this function is not inlined.
The macro ADVISE in Clozure Common Lisp
Patching functions in Clozure CL can be done with the macro ADVISE. See the documentation for advising.
Let's say we have a function FOOBAR:
? (defun foobar (a b &key c (d :foobar)) (list a b c d))
FOOBAR
FOOBAR gets called inside TEST:
? (defun test (a) (foobar a 20 :c 30))
TEST
? (test 10)
(10 20 30 :FOOBAR)
We now want to patch FOOBAR such that named arg :D gets called with a different value.
We change the arglist to insert the new named argument after the two required args:
? (advise foobar (let ((arglist (list* (first arglist)
(second arglist)
:d :ipv6
(cddr arglist))))
(:do-it)) ; calling the original function
:when :around ; advise around it
:name :ipv6) ; the name of this advise
#<Compiled-function (CCL::ADVISED 'FOOBAR) (Non-Global) #x3020010D1CCF>
Now we can call our TEST function and it will call the advised function FOOBAR.
? (test 10)
(10 20 30 :IPV6)
Advise for CCL:MAKE-SOCKET
You could write a similar advise for CCL:MAKE-SOCKET.
Untested:
(advise ccl:make-socket (let ((arglist (list* :address-family
:internet6
arglist)))
(:do-it))
:when :around
:name :internet6)
This can be done!
First make a copy of the original make-socket
(IN-PACKAGE :ccl)
(DEFPARAMETER original-make-socket #'make-socket)
Then redefine make-socket. Note: You will have to provide the full spec for all keyword parameters. As it is, I've used only the ones from your question for demonstration.
(defun make-socket (&key (remote-host "defau.lt")
(remote-port 443)
(address-family :internet6))
(declare (ignore address-family))
(format t "Calling new make-socket with address-family as internet6!")
(funcall original-make-socket
:remote-host remote-host
:remote-port remote-port
:address-family :internet6))
This will signal a continuable error.
Type :go at the repl to continue.
This will successfully patch make-socket.
Now any calls to make-socket will be to the new definition. Try:
(IN-PACKAGE :cl-user)
(ccl:make-socket :remote-host "ya.ru" :remote-port 443 :address-family :IRRELEVANT)
Another way to do it, would be to override the global variable *warn-if-redefine-kernel* before redefining make-socket.
(setf *warn-if-redefine-kernel* nil)
This will avoid the continuable error signal, and straight patch the kernel function.
Related
I'm using IOLIB with this code to resolve a hostname:
(sockets:address-to-string (sockets:lookup-hostname name))
I works, but the functions does not take any timeout paramenter, and i cannot figure out how to set these using socket options.
Unfortunately this is not easy to find (in particular, this is not documented), but following the chain of calls from lookup-hostname (M-. in Emacs), you can see your code eventually calls dns-query:
(defun dns-query (name &key (type :a) (search *dns-search-domain*)
(nameservers *dns-nameservers*) decode
(repeat *dns-repeat*) (timeout *dns-timeout*))
...)
The timeout argument defaults to a special variable iolib/sockets::*dns-timeout*, which is globally bound to 10. You then only need to bind it around your code to set a different timeout:
(let ((iolib/sockets::*dns-timeout* 1))
...)
The variable is not exported, but dns-query is, maybe it is better to call that function directly.
CL-USER> (iolib:dns-query "http://example.com" :timeout 0.0001)
NIL
CL-USER> (iolib:dns-query "http://example.com" :timeout 1)
#<DNS RESPONSE Id: 61273, Question: #(#<"http://example.com." A IN>) Flags: :OP/S :RD :RA :NAME-ERROR, Sections: QD(1) AN(0) NS(1) AD(0)>
I am not satisfied to find files matching a string like this:
(remove-if-not (lambda (it)
(search "wildcard" (namestring it)))
(uiop:directory-files "./"))
;; I'll ignore case with str:contains?
;; https://github.com/vindarel/cl-str
How would one search for files with unix-style wildcards ?
If it is not built-in, I'd enjoy a solution with uiop. Maybe there is with Osicat or cl-fad (with which it doesn't seem so, the documentation oftentimes says "non-wild pathname").
Bonus if it is possible to use the double wildcard to traverse directories recursively (./**/*.jpg).
edit: I have tried variants of (directory #p"./**/*.jpg") and it returns nil :( Also tried #p".*jpg", #p"./.*jpg",…
(wild-pathname-p (pathname "*.jpg"))
(:WILD :WILD-INFERIORS)
(make-pathname :name :wild :type "jpg")
#P"*.jpg"
The following gets me files by jpg extension, but it isn't a proper wildcard yet:
(directory *)
(#P"/home/vince/cl-cookbook/AppendixA.jpg"
#P"/home/vince/cl-cookbook/AppendixB.jpg"
#P"/home/vince/cl-cookbook/AppendixC.jpg")
Documentation on pathnames and make-pathname: http://gigamonkeys.com/book/files-and-file-io.html (no mentions of wildcards)
SBCL
SBCL supports wildcards in names. First, create some files:
(loop
with stem = #P"/tmp/stack/_.txt"
initially (ensure-directories-exist stem)
for name in '("abc" "def" "cadar" "cdadr" "cddr")
for path = (make-pathname :name name :defaults stem)
do (open path :direction :probe :if-does-not-exist :create))
Then, list all files that contains an "a":
CL-USER> (directory #P"/tmp/stack/*a*.txt")
(#P"/tmp/stack/abc.txt" #P"/tmp/stack/cadar.txt" #P"/tmp/stack/cdadr.txt")
The pathname contains an implementation-specific (valid) name component:
CL-USER> (describe #P"/tmp/stack/*a*.txt")
#P"/tmp/stack/*a*.txt"
[structure-object]
Slots with :INSTANCE allocation:
HOST = #<SB-IMPL::UNIX-HOST {10000F3FF3}>
DEVICE = NIL
DIRECTORY = (:ABSOLUTE "tmp" "stack")
NAME = #<SB-IMPL::PATTERN :MULTI-CHAR-WILD "a" :MULTI-CHAR-WILD>
TYPE = "txt"
VERSION = :NEWEST
; No value
SBCL also defines sb-ext:map-directory, which process files one by one, instead of first collecting all files in a list.
Portable solutions
If you need to stick to standard pathname components, you can first call directory with normal wildcards, and filter the resulting list:
CL-USER> (remove-if-not (wildcard "*a*")
(directory #P"/tmp/stack/*.txt")
:key #'pathname-name)
(#P"/tmp/stack/abc.txt" #P"/tmp/stack/cadar.txt" #P"/tmp/stack/cdadr.txt")
... where wildcard might be based on regex (PPCRE):
(defun parse-wildcard (string)
(delete ""
(map 'list
(lambda (string)
(or (cdr (assoc string
'(("*" . :wild)
("?" . :char))
:test #'string=))
string))
(ppcre:split '(:sequence
(:negative-lookbehind #\\)
(:register (:alternation #\* #\?)))
string
:with-registers-p t))
:test #'string=))
(note: the above negative lookbehind does not eliminate escaped backslashes)
(defun wildcard-regex (wildcard)
`(:sequence
:start-anchor
,#(loop
for token in wildcard
collect (case token
(:char :everything)
(:wild '(:greedy-repetition 0 nil :everything))
(t token)))
:end-anchor))
(defun wildcard (string)
(let ((scanner (ppcre:create-scanner
(wildcard-regex (parse-wildcard string)))))
(lambda (string)
(ppcre:scan scanner string))))
Intermediate functions:
CL-USER> (parse-wildcard "*a*a\\*a?\\?a")
(:WILD "a" :WILD "a\\*a" :CHAR "\\?a")
CL-USER> (wildcard-regex (parse-wildcard "*a*a\\*a?\\?a"))
(:SEQUENCE :START-ANCHOR #1=(:GREEDY-REPETITION 0 NIL :EVERYTHING) "a" #1# "a\\*a" :EVERYTHING "\\?a" :END-ANCHOR)
no current directory and no home directory characters
The concept of . denoting the current directory does not exist in portable Common Lisp. This may exist in specific filesystems and specific implementations.
Also ~ to denote the home directory does not exist. They may be recognized by some implementations as non-portable extensions.
In pathname strings you have * and ** as wildcards. This works in absolute and relative pathnames.
defaults for the default pathname
Common Lisp has *default-pathname-defaults* which provides a default for some pathname operations.
Examples
CL-USER 46 > (directory "/bin/*")
(#P"/bin/[" #P"/bin/bash" #P"/bin/cat" .... )
Now in above it is already slightly undefined or diverging what implementations do on Unix:
resolve symbolic links?
include 'hidden' files?
include files with types?
Next:
CL-USER 47 > (directory "/bin/*sh")
(#P"/bin/zsh" #P"/bin/tcsh" #P"/bin/sh" #P"/bin/ksh" #P"/bin/csh" #P"/bin/bash")
Using a relative pathname:
CL-USER 48 > (let ((*default-pathname-defaults* (pathname "/bin/")))
(directory "*sh"))
(#P"/bin/zsh" #P"/bin/tcsh" #P"/bin/sh" #P"/bin/ksh" #P"/bin/csh" #P"/bin/bash")
Files in your home directory:
CL-USER 49 > (let ((*default-pathname-defaults* (user-homedir-pathname)))
(directory "*"))
The same:
CL-USER 54 > (directory (make-pathname :name "*"
:defaults (user-homedir-pathname)))
Finding all files ending with sh in /usr/local/ and below:
CL-USER 54 > (directory "/usr/local/**/*sh")
Constructing pathnames with MAKE-PATHNAME
Three ways to find all .h files under /usr/local/:
(directory "/usr/local/**/*.h")
(directory (make-pathname :name :wild
:type "h"
:defaults "/usr/local/**/")
(directory
(make-pathname :name :wild
:type "h"
:directory '(:ABSOLUTE "usr" "local" :WILD-INFERIORS)))
Problems
There are a lot of different interpretations of implementations across platforms ('windows', 'unix', 'mac', ...) and even on the same platform (especially 'windows' or 'unix'). Stuff like unicode in pathnames creates additional complexity - not describe in the CL standard.
We still have a lot of different filesystems ( https://en.wikipedia.org/wiki/List_of_file_systems ), but they are different or different in capabilities from what was typical when Common Lisp was designed. Implementations may have tracked the changes, but not necessarily in portable ways.
I'm trying to use drakma-async in my small project. But I just can't understand what's happening. (I use emacs + slime + ccl). I need to get data with http(s) and parse it in a callback. I assume I can get wrong data that cannot be parsed, so I want to make a retry. But when I tried to make some tests I just can't understand what's happening...
(defun my-callback (data)
(prin1 data)
(restart-case
(error "Some error parsing data...")
(just-continue () (prin1 "Continue..."))))
(defun simple-test ()
(let ((future (asf:make-future)))
(as:delay #'(lambda () (asf:finish future "Some data")) :time 2)
(prin1 (asf:future-finished-p future))
(asf:attach future #'my-callback)))
(defun drakma-test ()
(asf:alet ((response (das:http-request "http://www.google.com")))
;(prin1 (asf:future-finished-p response))
(asf:attach response #'my-callback)))
(defun drakma-test-let ()
(let ((response (das:http-request "http://www.google.com")))
;(prin1 (asf:future-finished-p response))
(asf:attach response #'my-callback)))
(defun run-test (test)
(as:start-event-loop test))
1) So I will that's what I have with my simple example (that's what I've planned)
? (run-test #'simple-test)
NIL"Some data" ;I get debugger here with simple-error and choose my restart
Invoking restart: #<RESTART JUST-CONTINUE #x7F0578EC20AD>
"Continue..."
1
2) Here what I get in second test:
? (run-test #'drakma-test)
"<A LOT OF HTML>
"
1
Where are my debugger and my restart?
3) Uncomment the ;(prin1 (asf:future...)) line in drakma-test
? (run-test #'drakma-test)
1
No finished/unfinished bool, No Data is not printed, I don't get a restart, I just get 1 as result.
4) I assume if i write (let ((reponse (das:http-request "http://www.google.com"))) ... )
instad of (asf:alet ...) the response will contain not future object, but will block until the request will be finished and the response will contain the data.
? (run-test #'drakma-test-let)
1
5) Uncomment the ;(prin1 (asf:future...)) line in drakma-test-let
? (run-test #'drakma-test-let)
NIL ;future is not finished
1
Data is not printed, just that is not finished and the result of run-test.
I've run tests for cl-async and they all passed except the ipv6 test. So I just don't know where to start to understand whats happening... Why I get no debugger and restart in 2nd test? Why nothing happens in 3rd test (it's the same as 2nd, but with prin1). Why nothing happens in 5th and 5th tests?
P.S. Don't have enough reputation to create drakma-async or cl-async tags for this libraries. I know that drakma-async is built over drakma so I put this tag.
Thanks for m-n's comment that made the situation clearer and explained shortly the situation.
I made some examples and want to show what happens in each case:
Example:
(defun my-callback (&rest data)
(format t "Echo from callback: ~A~%" data)
(restart-case
(error "Some error parsing data...")
(just-continue () (prin1 "Continue..."))))
(defun my-errback (e)
(format t "Echo from errback: ~A~%" e))
(defun make-example-future ()
(let ((future (asf:make-future))) ;creating future
(as:delay #'(lambda () ;finishing future in 2 seconds
(asf:future-handler-case ;wrapping asf:finish
(asf:finish future
"Result data")
(t (e) (asf:signal-error future e)))) ;signal future an error
:time 2)
future))
(defun simple-test-2 ()
(let ((future (make-example-future)))
(format t "Is future?: ~A~%Finished?: ~A~%"
(asf:futurep future) (asf:future-finished-p future))
(asf:alet ((result future))
(asf:attach-errback future #'my-errback)
(format t "Finished? ~A~%" (asf:future-finished-p future))
(asf:future-finished-p result)
(asf:attach result #'my-callback))))
And here is what's happening:
? (as:start-event-loop #'simple-test-2)
Is future?: T
Finished?: NIL
;<here we have a 2 sec pause>
Finished? T
Echo from errback: There is no applicable method for the generic function:
#<STANDARD-GENERIC-FUNCTION CL-ASYNC-FUTURE:FUTURE-FINISHED-P #x302001B67A8F>
when called with arguments:
("Result data")
A) asf:alet wait for result and bind the result value to the variable.
So I was wrong thinking that asf:alet bind a future.
B) In make-example-future we wrap asf:finish with asf:future-handler-case
and use asf:signal-error to send error to future.
That means that error is handled and the errback will be called.
Even if the callback is attached later in the code.
Moreover, the error with (asf:future-finished-p result)
was handled with future-handler-case because it was wrapped in asf:alet (At least I think so).
C) Comment the (asf:future-finished-p result) and the result is
Is future?: T
Finished?: NIL
Finished? T
Echo from callback: (Result data) ;here is my data
Echo from errback: Some error parsing data... ;;here is my error
1
In drakma-async there is similar future-handler-case wrapper that wraps asf:finish.
So this explains the #2 test result. I got the data and asf:alet returned me the string. The error from callback was passed to errback, which I didn't have.
Moreover. In drakma-test using only asf:alet I just can't attach errback because I don't have access to future. I need to call http-request in let, not in alet.
Also this explains the result of the #3 test: I got error in (future-finished-p) which was sent to errback.
If we look at the result of #4 and #5 test with new my-callback: It can be seen, that
cl-async try to call my callback with all values the drakma returned. There are 7 of them (the values that drakma:http-request return).
So I tried to attach wrong number of arguments callback and my #4 and #5 tests were signalling an error that was simply handled by that future-hander-case and send it to errback.
Result:
Anyway, it seems impossible to use restarts with drakma-async without removing that future-handler-case because it send error to errback, but lose all restarts.
Hope this post helps if somebody fill face up with my question.
I got a set of classes which represent a message that has to be handled. But there is only a limited amount of open spots for handlers. Therefore any "dispatch" of a handler handling an message object has to check first whether there is a free spot.
If there is -> dispatch.
If there is not -> do not dispatch and return corresponding message
As this part of the code will be the same in any dispatch method I figured it would be best to use the method combination facility to enforce that, but I cannot figure out how.
In my current code base I tried to use a :before method, but apparently you cannot use return in such context:
(defclass message () ((msg :initarg :msg :reader msg)))
(defclass message-ext (message)
((univ-time :initarg :univ-time :reader univ-time)))
(defparameter *open-handler* nil)
(defgeneric handle (message)
(:documentation "handle the given message appropriately"))
(defmethod handle :before ((message message))
(when (> (length *open-handler*) 1)
(return :full)))
(defmethod handle ((message message))
(push (FORMAT nil "dispatched handler") *open-handler*))
(defmethod handle ((message-ext message-ext))
(push (FORMAT nil "dispatched ext handler") *open-handler*))
(handle (make-instance 'message :msg "allemeineentchen"))
(handle (make-instance 'message-ext
:msg "rowrowrowyourboat"
:univ-time (get-universal-time)))
(handle (make-instance 'message-ext
:msg "gentlydownthestreet"
:univ-time (get-universal-time)))
Execution of a form compiled with errors.
Form:
(RETURN-FROM NIL FULL)
Compile-time error:
return for unknown block: NIL
[Condition of type SB-INT:COMPILED-PROGRAM-ERROR]
Restarts:
0: [RETRY] Retry SLIME interactive evaluation request.
1: [*ABORT] Return to SLIME's top level.
2: [TERMINATE-THREAD] Terminate this thread (#<THREAD "worker" RUNNING {100594F743}>)
Backtrace:
0: ((SB-PCL::FAST-METHOD HANDLE :BEFORE (MESSAGE)) #<unavailable argument> #<unavailable argument> #<unavailable argument>)
1: ((SB-PCL::EMF HANDLE) #<unavailable argument> #<unavailable argument> #<MESSAGE-EXT {1005961733}>)
2: (SB-INT:SIMPLE-EVAL-IN-LEXENV (HANDLE (MAKE-INSTANCE 'MESSAGE-EXT :MSG "gentlydownthestreet" :UNIV-TIME (GET-UNIVERSAL-TIME))) #<NULL-LEXENV>)
3: (EVAL (HANDLE (MAKE-INSTANCE 'MESSAGE-EXT :MSG "gentlydownthestreet" :UNIV-TIME (GET-UNIVERSAL-TIME))))
4: ((LAMBDA () :IN SWANK:INTERACTIVE-EVAL))
Is this approach even sane, and if yes how can I do it in a working fashion? (I did already try return-from with the same result)
I think you should be using the :around method qualifier instead:
(defmethod handle :around ((message message))
(if (cddr *open-handler*)
:full
(call-next-method)))
However, a more "lispy" approach is to use the CL Condition System, e.g., something like this:
(define-condition too-many-messages (...) (...) ...)
(defun add-message (message)
(when (cddr *open-handler*)
(signal 'too-many-messages))
(push message *open-handler*))
(defmethod handle ((message message))
(add-message (FORMAT nil "dispatched handler")))
You will have to handle the condition (using, e.g., handler-bind) in addition to checking the return values of your handle function.
PS. Calling length on a list to check that it is long enough is not a very good idea - although in your case, when the list is guaranteed to be short, this might be more of a style issue.
PPS. It is not a very good idea to use the word handle as a name of your function because CL has functions which contain it (e.g., handler-case). This will complicate the search in your code in addition to confusing people reading your code.
You can't call RETURN to return from a function like that.
You would need to use RETURN-FROM with the function name. But here it would return from the method - not the generic function.
#sds has an answer. Another one would be to signal a user defined condition and handle it somewhere else. Older code used catch and throw.
A more complex undertaking would be a user defined method combination.
While using Clojure proxies, fns passed to proxy should override existing methods or are they called in conjunction with super.method()?
In the following code, RequestHandler.get() is invoked along with the proxy get [].
;see: http://github.com/paulosuzart/JTornado
(ns org.ctornadoweb)
(import '(org.jtornadoweb Web$RequestHandler))
(import '(org.jtornadoweb HttpServer Web$Application))
(let [myHandler (proxy [Web$RequestHandler] []
(get []
(.write "Hi CLJ"))
(post []
(.write "POST")))]
(.listen
(HttpServer.
(.add (Web$Application.) "/" (class myHandler))
false nil false) 8089))
The same happens to the compiled/inheritance version:
; Starts a JTornado HTTP Server and a sample RequestHandler.
; Bit verbose due to compilation directives. Recommendation is to generate
; a set of macros to hide this.
(ns org.ctornadoweb
; Compiled and implements a static main method to start the server
(:import (org.jtornadoweb HttpServer)
(org.jtornadoweb.Web$Application)
(org.jtornadoweb.Web$RequestHandler))
(:gen-class :prefix "server-"))
(gen-class
:name org.ctornadoweb.MyHandler
:extends org.jtornadoweb.Web$RequestHandler
:prefix "do")
(defn do-get [this]
"Handles the HTTP GET method"
(.write "hello clojure"))
(defn do-post [this]
"Handles the HTTP POST method"
(.write (.getArgument "name" "default" false)))
(defn server-main []
"main method"
(.listen
(org.jtornadoweb.HttpServer.
(.add (org.jtornadoweb.Web$Application.) "/" org.ctornadoweb.MyHandler)
false nil false) 8089))
;use (compile 'org.ctornadoweb)
The trace shows the proxy get being invoked and then the super.get, what throws (by default) an exception.
HTTP 405: Method Not Allowed
at org.jtornadoweb.Web$RequestHandler.get(Web.java:72)
at org.ctornadoweb.proxy$org.jtornadoweb.Web$RequestHandler$0.get(Unknown Source)
I tried to find some words about the actual behavior of Clojure Proxies. Can someone give this help?
No, the super method will not be called automatically, though you can explicitly call it with proxy-super.
The following test case shows things working as they should:
user=> (def foo
(proxy [java.util.ArrayList] []
(clear [] (println "not clearing"))))
#'user/foo
user=> (.size foo)
0
user=> (.add foo "hi")
true
user=> (.add foo "bye")
true
user=> (.size foo)
2
user=> (.clear foo)
not clearing
nil
user=> (.size foo)
2
If super.clear() were getting called, the size would show as 0.