README.md

@@ -1,73 +0,0 @@
-# xattr
-## Interface for extended filesystem attributes
-
-[Extended attributes](https://en.wikipedia.org/wiki/Extended_attributes) are a special type of file attribute that lets you associate key-value pairs with a file without actually modifying the file's contents. Commonly used for program settings, tagging, and file metadata (i.e., storing a file's author with a key like “author.name”) xattrs can be used for used for pretty much anything you can dream up. They're mega-cool and useful.
-
-This is a simple interface for accessing them within [Chicken Scheme](https://call-cc.org/), a friendly Scheme.
-
-
-## API
-### get-xattr
-`get-xattr path attr`
-
-Returns the string-value of a file's extended attribute.  
-If the file has no such attribute, #f is returned. In other cases (e.g., the file doesn't exist, permission not available, no filesystem support), exceptions are raised.
-
-### set-xattr
-`set-xattr path attr value`
-
-Sets the string-value of a file's extended attribute.  
-The set value is returned, if successful.
-
-### remove-xattr
-`remove-xattr path attr`
-
-Removes an extended attribute from a file.  
-The value of the removed attribute is returned, if successful.
-
-### list-xattrs
-`list-xattrs path`
-
-Returns a list of the file's extended attribute names.
-
-
-## Examples
-```
-(import xattr (chicken io) (chicken file))
-;; Create the test file
-(call-with-output-file "testing.txt"
-                       (lambda (out-port) (write-line "Just a test!" out-port)))
-
-(set-xattr "testing.txt" "user.dublincore.author" "Migdal E. F. Lemmings")
-(set-xattr "testing.txt" "user.dublincore.title" "A Treatise on Almonds")
-
-(get-xattr "testing.txt" "user.dublincore.author")
-;; Returns "Migdal E. F. Lemmings"
-
-(list-xattrs "testing.txt")
-;; Returns '("user.dublincore.author" "user.dublincore.title")
-
-(remove-xattr "testing.txt" "user.dublincore.title")
-;; Returns "A Treatise on Almonds"
-
-(list-xattrs "testing.txt")
-;; Now returns '("user.dublincore.author")
-```
-
-
-## On GNU/Linux
-Currently, this egg only supports LiGNUx, a platform that has a particularity: The name of each attribute must contain a “namespace,” separated from the actual name by a period. For example, with the attribute named `user.xdg.origin.url`, the namespace is `user` and the name is `xdg.origin.url`. In most cases, you won't stray from the `user` namespace.  
-
-Don't forget to prepend “user.” to your attribute names!
-
-A handy list of somewhat-standard extended attributes is hosted on FreeDesktop's website, [here](https://www.freedesktop.org/wiki/CommonExtendedAttributes/).
-
-
-## Requirements
-This egg requires `srfi-1` and `srfi-12`.
-
-
-## Meta
-**Author:** Jaidyn Ann <jadedctrl@posteo.at>  
-**License:** GPLv3  
-**Source:** https://github.com/jadedctrl/xattr, https://notabug.org/jadedctrl/xattr

xattr.egg

@@ -1,7 +1,9 @@
 ;; -*- Scheme -*-
 ((synopsis "Access to extended attributes")
  (author "Jaidyn Ann")
- (category io)
+ (category net)
  (license "GPLv3")
- (dependencies srfi-1)
+
  (components (extension xattr)))
+;;						(csc-options "-O3" "-d1" "-X" "bind" "-s" "-k" "-emit-link-file" "xattr.link" "-o" "xattr_ext.o"))
+;;			 (c-object xattr_ext)))

xattr.scm

@@ -1,5 +1,5 @@
 ;;
-;; Copyright 2024, Jaidyn Levesque <jadedctrl@posteo.at>
+;; Copyright 2022, Jaidyn Levesque <jadedctrl@posteo.at>
 ;;
 ;; This program is free software: you can redistribute it and/or
 ;; modify it under the terms of the GNU General Public License as
@@ -16,23 +16,20 @@
 ;;
 
 (module xattr
-    (get-xattr set-xattr remove-xattr list-xattrs)
+  (get-xattr set-xattr remove-xattr list-xattr)
 
-  (import scheme
+(import (chicken base) (chicken memory) srfi-1 scheme (chicken foreign) srfi-12)
-          (chicken base) (chicken condition) (chicken foreign) (chicken memory)
+
-          srfi-1)
+(foreign-declare "#include \"xattr_ext.c\"")
 
 
-  (foreign-declare "#include \"xattr_ext.c\"")
+;; The direct foreign binding for `get_xattr`
-
+(define get-xattr-foreign
-
-  ;; The direct foreign binding for `get_xattr`
-  (define get-xattr-foreign
   (foreign-lambda c-string* "get_xattr" c-string c-string (c-pointer int)))
 
 
-  ;; Wrapper around get-xattr-foreign, which throws exceptions and such.
+;; Wrapper around get-xattr-foreign, which throws exceptions and such.
-  (define (get-xattr path attr)
+(define (get-xattr path attr)
   (let-location ([error-code int])
     (let ([attr-value (get-xattr-foreign path attr (location error-code))]
 		  [exception (or (getxattr-exception error-code)
@@ -42,16 +39,16 @@
 		  attr-value))))
 
 
-  ;; The direct foreign binding for `list_xattr`
+;; The direct foreign binding for `list_xattr`
-  (define list-xattrs-foreign
+(define list-xattr-foreign
   (foreign-lambda (c-pointer char) "list_xattr" c-string (c-pointer ssize_t) (c-pointer int)))
 
 
-  ;; Wrapper around list-xattrs-foreign, which throws exceptions and such.
+;; Wrapper around list-xattr-foreign, which throws exceptions and such.
-  (define (list-xattrs path)
+(define (list-xattr path)
   (let-location ([error-code int]
 				 [length ssize_t])
-      (let ([list-pointer (list-xattrs-foreign path (location length) (location error-code))]
+    (let ([list-pointer (list-xattr-foreign path (location length) (location error-code))]
 		  [exception (or (getxattr-exception error-code)
 						 (stat-exception error-code))])
 	  (if exception
@@ -60,13 +57,13 @@
 		  (pointer->delimited-string-list list-pointer length 0)))))
 
 
-  ;; The direct foreign binding for `set_xattr`
+;; The direct foreign binding for `set_xattr`
-  (define set-xattr-foreign
+(define set-xattr-foreign
   (foreign-lambda int "set_xattr" c-string c-string c-string (c-pointer int)))
 
 
-  ;; Wrapper around set-xattr-foreign, throwing exceptions and all that jazz
+;; Wrapper around set-xattr-foreign, throwing exceptions and all that jazz
-  (define (set-xattr path attr value)
+(define (set-xattr path attr value)
   (let-location ([error-code int])
     (let ([return-code (set-xattr-foreign path attr value (location error-code))]
 		  [exception (or (setxattr-exception error-code)
@@ -77,28 +74,29 @@
 		  value))))
 
 
-  ;; The direct foreign binding for `remove_xattr`
+;; The direct foreign binding for `remove_xattr`
-  (define remove-xattr-foreign
+(define remove-xattr-foreign
   (foreign-lambda int "remove_xattr" c-string c-string))
 
 
-  ;; Wrapper around remove-xattr-foreign, blah blah
+;; Wrapper around remove-xattr-foreign, blah blah
-  (define (remove-xattr path attr)
+(define (remove-xattr path attr)
-    (let* ([value (get-xattr path attr)]
+  (let* ([error-code (remove-xattr-foreign path attr)]
-           [error-code (remove-xattr-foreign path attr)]
 		 [exception (or (getxattr-exception error-code)
 						(stat-exception error-code))])
 	(if exception
 		(signal exception)
-          value)))
+		attr)))
 
 
-  ;; TODO: These exception functions should be constructed with a macro and a simple
+;; TODO: These exception functions should be constructed with a macro and a simple
-  ;; list, like `((c-constant symbol error-message) ("E2BIG" 'e2big "The attribute value was too big."))
+;; list, like `((c-constant symbol error-message) ("E2BIG" 'e2big "The attribute value was too big."))
+;; Unfortunately, it looks like chicken's macros work a good bit differently from CLs?
+;; orr I'm losing my mind
 
 
-  ;; Return the exception associated with an error-code as per getxattr(2), if it exists
+;; Return the exception associated with an error-code as per getxattr(2), if it exists
-  (define (getxattr-exception error-code)
+(define (getxattr-exception error-code)
   (cond
    [(eq? error-code (foreign-value "E2BIG" int))
 	(build-exception 'e2big "The attribute value was too big.")]
@@ -110,8 +108,8 @@
 	#f]))
 
 
-  ;; Return the exception associated with a setxattr(2) error-code, if it exists.
+;; Return the exception associated with a setxattr(2) error-code, if it exists.
-  (define (setxattr-exception error-code)
+(define (setxattr-exception error-code)
   (cond
    [(eq? error-code (foreign-value "EDQUOT" int))
 	(build-exception 'edquot "Setting this attribute would violate disk quota.")]
@@ -125,8 +123,8 @@
 	#f]))
 
 
-  ;; Return the exception associated with an error-code as per stat(2), if applicable
+;; Return the exception associated with an error-code as per stat(2), if applicable
-  (define (stat-exception error-code)
+(define (stat-exception error-code)
   (cond
    [(eq? error-code (foreign-value "EACCES" int))
 	(build-exception 'file "Search permission denied for a parent directory.")]
@@ -152,30 +150,25 @@
 	#f]))
 
 
-  ;; Creates a generic exception with given symbol and message
+;; Creates a generic exception with given symbol and message
-  (define (build-exception symbol message)
+(define (build-exception symbol message)
   (signal (make-property-condition 'exn 'location symbol 'message message)))
 
 
-  ;; Some C functions offer up a string-list that isn't a two-dimensional array, but a
+;; Some C functions offer up a string-list that isn't a two-dimensional array, but a
-  ;; one-dimensional array with given length and strings separated by a given delimeter.
+;; one-dimensional array with given length and strings separated by a given delimeter.
-  ;; This takes that sort of pointer and gives you a nice list of strings.
+;; This takes that sort of pointer and gives you a nice list of strings.
-  (define (pointer->delimited-string-list pointer length delimiter)
+(define (pointer->delimited-string-list pointer length delimiter)
   (let* ([is-zero (lambda (num) (eq? num 0))]
 		[map-to-char (lambda (a) (map integer->char a))]
-           [pointer-ints (pointer->integers pointer length)]
+		[byte-list (drop-right (pointer->integers pointer length) 1)])
-           [byte-list (when (list? pointer-ints)
-                        (drop-right pointer-ints 1))])
-      (if (and (list? byte-list)
-               (not (null-list? byte-list)))
 	(map list->string
 		 (map map-to-char
-                   (split-list is-zero byte-list)))
+			  (split-list is-zero byte-list)))))
-        '())))
 
 
-  ;; Takes a pointer and returns a list of bytes of a given length
+;; Takes a pointer and returns a list of bytes of a given length
-  (define (pointer->integers pointer length)
+(define (pointer->integers pointer length)
   (let ([byte (pointer-s8-ref pointer)])
 	(if (eq? length 0)
 		byte
@@ -183,8 +176,8 @@
 				(pointer->integers (pointer+ pointer 1) (- length 1))))))
 
 
-  ;; Split a list into sublists, with items passing `test` being the delimiters
+;; Split a list into sublists, with items passing `test` being the delimiters
-  (define (split-list test list)
+(define (split-list test list)
   (let ([before (take-while (compose not test) list)]
 		[after (drop-while (compose not test) list)])
 	(cond
@@ -193,4 +186,6 @@
 	 [(null-list? before)
 	  (split-list test (cdr after))]
 	 [#t
-        (append `(,before) (split-list test (cdr after)))]))))
+	  (append `(,before) (split-list test (cdr after)))])))
+
+)