syscalls: Use 'define-c-struct' for 'fcntl-flock'.
* guix/build/syscalls.scm (%struct-flock): Use 'define-c-struct'. (fcntl-flock): Use 'write-flock!' and 'make-bytevector' instead of 'make-c-struct'.
This commit is contained in:
		
							parent
							
								
									4e0ea3eb28
								
							
						
					
					
						commit
						d33c8b4649
					
				
					 1 changed files with 24 additions and 17 deletions
				
			
		|  | @ -643,13 +643,16 @@ system to PUT-OLD." | ||||||
| ;;; Advisory file locking. | ;;; Advisory file locking. | ||||||
| ;;; | ;;; | ||||||
| 
 | 
 | ||||||
| (define %struct-flock | (define-c-struct %struct-flock                    ;<fcntl.h> | ||||||
|   ;; 'struct flock' from <fcntl.h>. |   sizeof-flock | ||||||
|   (list short                                     ; l_type |   list | ||||||
|         short                                     ; l_whence |   read-flock | ||||||
|         size_t                                    ; l_start |   write-flock! | ||||||
|         size_t                                    ; l_len |   (type   short) | ||||||
|         int))                                     ; l_pid |   (whence short) | ||||||
|  |   (start  size_t) | ||||||
|  |   (length size_t) | ||||||
|  |   (pid    int)) | ||||||
| 
 | 
 | ||||||
| (define F_SETLKW | (define F_SETLKW | ||||||
|   ;; On Linux-based systems, this is usually 7, but not always |   ;; On Linux-based systems, this is usually 7, but not always | ||||||
|  | @ -690,21 +693,25 @@ exception if it's already taken." | ||||||
|             (fileno fd-or-port) |             (fileno fd-or-port) | ||||||
|             fd-or-port)) |             fd-or-port)) | ||||||
| 
 | 
 | ||||||
|  |       (define bv | ||||||
|  |         (make-bytevector sizeof-flock)) | ||||||
|  | 
 | ||||||
|  |       (write-flock! bv 0 | ||||||
|  |                     (operation->int operation) SEEK_SET | ||||||
|  |                     0 0                           ;whole file | ||||||
|  |                     0) | ||||||
|  | 
 | ||||||
|       ;; XXX: 'fcntl' is a vararg function, but here we happily use the |       ;; XXX: 'fcntl' is a vararg function, but here we happily use the | ||||||
|       ;; standard ABI; crossing fingers. |       ;; standard ABI; crossing fingers. | ||||||
|       (let ((err (proc fd |       (let ((ret (proc fd | ||||||
|                        (if wait? |                        (if wait? | ||||||
|                            F_SETLKW               ; lock & wait |                            F_SETLKW               ; lock & wait | ||||||
|                            F_SETLK)               ; non-blocking attempt |                            F_SETLK)               ; non-blocking attempt | ||||||
|                        (make-c-struct %struct-flock |                        (bytevector->pointer bv))) | ||||||
|                                       (list (operation->int operation) |             (err (errno))) | ||||||
|                                             SEEK_SET |         (unless (zero? ret) | ||||||
|                                             0 0   ; whole file |           ;; Presumably we got EAGAIN or so. | ||||||
|                                             0))))) |           (throw 'flock-error err)))))) | ||||||
|         (or (zero? err) |  | ||||||
| 
 |  | ||||||
|             ;; Presumably we got EAGAIN or so. |  | ||||||
|             (throw 'flock-error (errno))))))) |  | ||||||
| 
 | 
 | ||||||
|  |  | ||||||
| ;;; | ;;; | ||||||
|  |  | ||||||
		Reference in a new issue