Permalink
Browse files

First part of parsing address strings.

  • Loading branch information...
1 parent a861a97 commit 61587069bd620182a16ac9041b101c86b451af80 @blitz committed Oct 26, 2008
Showing with 64 additions and 1 deletion.
  1. +1 −0 cl-dbus.asd
  2. +1 −1 cookie-sha1-auth.lisp
  3. +1 −0 packages.lisp
  4. +61 −0 transport.lisp
View
@@ -2,6 +2,7 @@
(defsystem cl-dbus
:components ((:file "packages")
+ (:file "transport" :depends-on ("packages"))
(:file "utilities" :depends-on ("packages"))
(:file "cookie-sha1-auth" :depends-on ("packages" "utilities"))
(:file "anonymous-auth" :depends-on ("packages" "utilities"))
View
@@ -70,7 +70,7 @@ epoch and the cookie itself (as string of hex digits)."
hashed-str)))))
;; Format our answer
(format-crlf stream "DATA ~A20~A"
- (to-hex-string my-challenge-str)
+ (string-to-hex-string my-challenge-str)
(string-to-hex-string digest)))
(force-output stream))))))
;; Now check if we get a positive reply.
View
@@ -5,6 +5,7 @@
(defpackage :blitz.desktop.dbus
(:use :common-lisp :iterate :defclass-star)
+ (:import-from :cl-ppcre "SPLIT" "SCAN-TO-STRINGS")
(:export))
(in-package :blitz.desktop.dbus)
View
@@ -0,0 +1,61 @@
+;;; -*- Mode: Lisp -*-
+;;; Copyright (c) 2008 Julian Stecklina
+;;;
+;;; This file is part of CL-DBUS. Look into LICENSE for license terms.
+
+(in-package :blitz.desktop.dbus)
+
+;;; Parsing the server address
+
+(defstruct server-address
+ type
+ values)
+
+(defun server-address-value (address key)
+ (gethash key (server-address-values address)))
+
+(defun unescape (string)
+ "String is an ASCII string with every non-ASCII (and some other)
+chars escaped by URI-style %XX sequences, with XX being hex-digits."
+ (with-input-from-string (in string)
+ (iter (with output = (make-array 0
+ :element-type '(unsigned-byte 8)
+ :fill-pointer t
+ :adjustable t))
+ (for char = (read-char in nil nil))
+ (while char)
+ (case char
+ (#\% (let ((digit1 (digit-char-p (read-char in) 16))
+ (digit2 (digit-char-p (read-char in) 16)))
+ (assert (and digit1 digit2)
+ (digit1 digit2)
+ "Got non-digits (~A ~A) after escape char..." digit1 digit2)
+ (vector-push-extend (logior (ash digit1 4) digit2) output)))
+ (t (vector-push-extend (char-code char) output)))
+ (finally (return (sb-ext:octets-to-string output :external-format :utf8))))))
+
+(defun parse-key-value-string (kv-string)
+ (iter (for part in (split "," kv-string))
+ (multiple-value-bind (match? matches)
+ (cl-ppcre:scan-to-strings "^([^=]+)=([^=]*)$" part)
+ (unless match?
+ (error "Malformed key-value pair: ~S" part))
+ (collect (cons (unescape (aref matches 0))
+ (unescape (aref matches 1)))))))
+
+(defun server-address-from-string (string)
+ (multiple-value-bind (match? matches)
+ (cl-ppcre:scan-to-strings "^([^:]+):(.*)$" string)
+ (unless match?
+ (error "Malformed DBUS server address ~S" string))
+ (make-server-address :type (aref matches 0)
+ :values (parse-key-value-string (aref matches 1)))))
+
+(defun parse-server-address-list (string)
+ (mapcar #'server-address-from-string
+ (split ";" string)))
+
+(defvar *transports* nil
+ "List of fu")
+
+;;; EOF

0 comments on commit 6158706

Please sign in to comment.