PowerShell
An experiment in sending tasks to PowerShell from CL. The Perl Batcave has this thing lying around: Win32::PowerShell::IPC. It's possible to steal this technique for Common Lisp. CCL handles a lot of the tricky OS-level details (like I/O on pipes). But a PowerShell "cmdlet" normally produces an array of objects—which have "properties"—and it can be expedient to get them in the form of S-expressions (or at least lists).

A quick-and-dirty way to do this is to arrange for PowerShell to format the result as one big string, and then parse the output into a Lisp list. This is done by designating two separator characters: the "vertical tab" character as a separator between objects, and the null character to separate properties within an object. These correspond (respectively) to #\PageUp and #\Nul in CCL, or `v and `0 in PowerShell. (Unlike many other languages, PowerShell uses the backtick as an escape character in double-quoted strings.)

The code

Licensed under Apache 2. The external-process management is specific to Clozure CL.

(defvar *powershell* nil "If set: an EXTERNAL-PROCESS.") (defun open-powershell () "Start PowerShell and save it in *POWERSHELL*." (setq *powershell* (run-program "powershell.exe" '("-Command" "-") :wait nil :input :stream :error :stream :output :stream))) (defun close-powershell (&optional (powershell *powershell*)) "Close associated streams, causing PowerShell to exit." (close (external-process-input-stream powershell)) (close (external-process-error-stream powershell)) (close (external-process-output-stream powershell))) (defun make-command-boundary (command) (loop for boundary-code = (random most-positive-fixnum) for boundary = (format nil "END_COMMAND_~36R" boundary-code) while (search boundary command) finally (return boundary))) (define-condition powershell-error (error) ((command :initarg :command :reader powershell-error-command) (string :initarg :string :reader powershell-error-string)) (:report (lambda (powershell-error reporting-stream) (format reporting-stream "PowerShell error on command ~S:~%~A" (powershell-error-command powershell-error) (powershell-error-string powershell-error))))) (defun run-powershell (command &optional (powershell *powershell*)) (let* ((input-stream (external-process-input-stream powershell)) (output-stream (external-process-output-stream powershell)) (error-stream (external-process-error-stream powershell)) (boundary (make-command-boundary command)) (end-line (format nil "echo ~A" boundary))) (write-line command input-stream) (write-line end-line input-stream) (force-output input-stream) (let ((result-string (with-output-to-string (result-stream) (loop with pending-line = nil for line = (read-line output-stream) until (equal line boundary) when pending-line do (write-line pending-line result-stream) do (setq pending-line line) finally (when pending-line ;; Don't write the trailing #\Newline. (write-string pending-line result-stream))))) ;; We have read up to (and including) the boundary. ;; Now consume all available output from ERROR-STREAM. (error-string (with-output-to-string (buffer) (loop for char = (read-char-no-hang error-stream) while char do (write-char char buffer))))) ;; Did we get an ERROR-STRING? (if (plusp (length error-string)) (error 'powershell-error :command command :string error-string) result-string)))) (defun parse-powershell-output (string) (when (equal string "") (return-from parse-powershell-output nil)) (let ((end (length string)) (pending-property (make-string-output-stream))) (macrolet ((get-property () `(get-output-stream-string pending-property))) (loop with (list sublist) = nil for i of-type fixnum from 0 to end for char = (when (< i end) (char string i)) do (cond ((or (= i end) (char= char #\PageUp)) (if sublist (progn (push (get-property) sublist) (push (nreverse sublist) list) (setq sublist nil)) ;; One property, no sublist. (push (get-property) list)) ;; Done parsing? (when (= i end) (return-from parse-powershell-output (nreverse list)))) ((char= char #\Nul) (push (get-property) sublist)) ((write-char char pending-property))))))) (defun run-powershell* (command &optional (powershell *powershell*)) (parse-powershell-output (run-powershell command powershell))) (defmacro $ (control-string &rest format-arguments) (let ((split-point (member '=> format-arguments))) (unless split-point (error "Expected => part.")) (multiple-value-bind (command-arguments property-selection-arguments) (values (ldiff format-arguments split-point) (rest split-point)) `(format nil "(~A | %{~A -join \"`0\"}) -join \"`v\"" (format nil ,control-string ,@command-arguments) (format nil ,@property-selection-arguments)))))

Usage examples

? (open-powershell) #<EXTERNAL-PROCESS (powershell.exe -Command -)[#<A Foreign Pointer #x7C4>] (RUNNING) #x2101A0216D>

Now the *powershell* variable is set to a running PowerShell. Here's an example of piping commands to it: find-big-folders recursively looks for folders containing more than 500 files. Then it returns the full pathname and modification time for each such directory. The run-powershell* function takes care of parsing the command output.

(defun find-big-folders (directory-name) (run-powershell* ($ "Get-ChildItem '~A' -Recurse ~ | Where-Object {$_.PSIsContainer -eq $True} ~ | Where-Object {$_.GetFiles().Count -gt 500}" directory-name => "$_.FullName, $_.LastWriteTime")))

Trying this on the directory where the HyperSpec lives:

? (find-big-folders "C:/HyperSpec") (("C:\\HyperSpec\\Body" "2/12/2020 8:03:53 AM") ("C:\\HyperSpec\\Issues" "2/12/2020 8:04:12 AM"))

Another example: extracting links from an HTML page via Invoke-WebRequest. This will signal an error if the page isn't accessible—namely, a Lisp condition of type powershell-error.

(defun get-links (url) (run-powershell* ($ "(Invoke-WebRequest '~A').Links" url => "$_.href, $_.innerHTML")))

This will provide a list of Win32 links:

? (get-links "https://cliki.net/Win32") (("https://github.com/Zulu-Inuoe/win32" "win32") ("/CFFI" "CFFI") ("https://github.com/Lovesan/doors" "Doors") ("/Windows" "Windows") ("https://github.com/quek/cl-win32ole/" "cl-win32ole") ("/SBCL" "SBCL") ("/CLISP" "CLISP") ("/cffi" "cffi") ("/trivial-garbage" "trivial-garbage") ("https://github.com/ailisp/Graphic-Forms" "Graphic-Forms") ("/Windows" "Windows") ("/BSD" "BSD") ("https://github.com/sharplispers/cormanlisp" "Corman Lisp") ("/Common%20Lisp%20implementation" "Common Lisp implementation") ("/Win32" "Current version") ("/site/history?article=Win32" "History") ("/site/backlinks?article=Win32" "Backlinks") ("/site/edit-article?title=Win32&amp;from-revision=3799349377" "Edit") ("/site/edit-article?create=t" "Create") ("/" "Home") ("/site/recent-changes" "Recent Changes") ("/CLiki" "About") ("/Text%20Formatting" "Text Formatting") ("/site/tools" "Tools") ("/site/register" "register"))

Then there's the Atom feed format. CLiki uses it. We can use XPath in PowerShell to select feed entries. Since Atom is a namespaced XML format, this requires providing the Namespace option to Select-XML:

(defparameter *atom-entry-properties* ;; A few atom:entry properties, e.g. innerText gives the HTML content, ;; assuming that "html" is the value of the <content type=""> attribute. "$_.Node.updated, $_.Node.link.href, $_.Node.content.innerText") (defun get-atom-entries (url) (run-powershell* ($ "Select-XML -XPath '//atom:entry' -Namespace @{atom='http://www.w3.org/2005/Atom'} ~ -Content (Invoke-WebRequest '~A')" url => *atom-entry-properties*)))

A wrinkle

There doesn't seem to be any obvious way to send Ctrl+C to PowerShell via IPC. So the problem is how to break out of a PowerShell command by signaling from Lisp.

Windows IPC