Compare commits

..

No commits in common. "72b5894823bcb4a6efdf5874f774d184d5aa50d5" and "6ac7a6b5353d9cd26861f0aa834f9652995e77f6" have entirely different histories.

3 changed files with 144 additions and 220 deletions

View File

@ -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

View File

@ -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)))

View File

@ -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,12 +16,9 @@
;;
(module xattr
(get-xattr set-xattr remove-xattr list-xattrs)
(import scheme
(chicken base) (chicken condition) (chicken foreign) (chicken memory)
srfi-1)
(get-xattr set-xattr remove-xattr list-xattr)
(import (chicken base) (chicken memory) srfi-1 scheme (chicken foreign) srfi-12)
(foreign-declare "#include \"xattr_ext.c\"")
@ -43,15 +40,15 @@
;; 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.
(define (list-xattrs path)
;; Wrapper around list-xattr-foreign, which throws exceptions and such.
(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
@ -84,17 +81,18 @@
;; Wrapper around remove-xattr-foreign, blah blah
(define (remove-xattr path attr)
(let* ([value (get-xattr path attr)]
[error-code (remove-xattr-foreign path attr)]
(let* ([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
;; 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
@ -163,15 +161,10 @@
(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 (when (list? pointer-ints)
(drop-right pointer-ints 1))])
(if (and (list? byte-list)
(not (null-list? byte-list)))
[byte-list (drop-right (pointer->integers pointer length) 1)])
(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
@ -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)))])))
)