Update copyright year

… my Emacs previously used tabs+spaces for Scheme,
which is genuinely horrific. >o<

README.md

@@ -0,0 +1,73 @@
+# 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,9 +1,7 @@
 ;; -*- Scheme -*-
 ((synopsis "Access to extended attributes")
  (author "Jaidyn Ann")
- (category net)
+ (category io)
  (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 2022, Jaidyn Levesque <jadedctrl@posteo.at>
+;; Copyright 2024, 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,9 +16,12 @@
 ;;
 
 (module xattr
-  (get-xattr set-xattr remove-xattr list-xattr)
+    (get-xattr set-xattr remove-xattr list-xattrs)
+
+  (import scheme
+          (chicken base) (chicken condition) (chicken foreign) (chicken memory)
+          srfi-1)
 
-(import (chicken base) (chicken memory) srfi-1 scheme (chicken foreign) srfi-12)
 
   (foreign-declare "#include \"xattr_ext.c\"")
 
@@ -40,15 +43,15 @@
 
 
   ;; The direct foreign binding for `list_xattr`
-(define list-xattr-foreign
+  (define list-xattrs-foreign
     (foreign-lambda (c-pointer char) "list_xattr" c-string (c-pointer ssize_t) (c-pointer int)))
 
 
-;; Wrapper around list-xattr-foreign, which throws exceptions and such.
-(define (list-xattr path)
+  ;; Wrapper around list-xattrs-foreign, which throws exceptions and such.
+  (define (list-xattrs path)
     (let-location ([error-code int]
                    [length ssize_t])
-    (let ([list-pointer (list-xattr-foreign path (location length) (location error-code))]
+      (let ([list-pointer (list-xattrs-foreign path (location length) (location error-code))]
             [exception (or (getxattr-exception error-code)
                            (stat-exception error-code))])
         (if exception
@@ -81,18 +84,17 @@
 
   ;; Wrapper around remove-xattr-foreign, blah blah
   (define (remove-xattr path attr)
-  (let* ([error-code (remove-xattr-foreign path attr)]
+    (let* ([value (get-xattr path attr)]
+           [error-code (remove-xattr-foreign path attr)]
            [exception (or (getxattr-exception error-code)
                           (stat-exception error-code))])
       (if exception
           (signal exception)
-		attr)))
+          value)))
 
 
   ;; 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."))
-;; 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
@@ -161,10 +163,15 @@
   (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))]
-		[byte-list (drop-right (pointer->integers pointer length) 1)])
+           [pointer-ints (pointer->integers pointer length)]
+           [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
@@ -186,6 +193,4 @@
        [(null-list? before)
         (split-list test (cdr after))]
        [#t
-	  (append `(,before) (split-list test (cdr after)))])))
-
-)
+        (append `(,before) (split-list test (cdr after)))]))))