[Scsh-checkins] CVS: scsh-0.6/scsh dot-locking.scm,1.1,1.2 scsh-interfaces.scm,1.28,1.29 scsh-package.scm,1.31,1.32

[Martin Gasbichler <mainzelm@users.sourceforge.net>]

Update of /cvsroot/scsh/scsh-0.6/scsh
In directory usw-pr-cvs1:/tmp/cvs-serv15316/scsh

Modified Files:
        dot-locking.scm scsh-interfaces.scm scsh-package.scm 
Log Message:
+ New names for dot-locking procedures.
+ Optional retry interval and counter for obtain-dot-lock
+ Exported crypt


Index: dot-locking.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/dot-locking.scm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -r1.1 -r1.2
*** dot-locking.scm     2000/09/27 11:53:21     1.1
--- dot-locking.scm     2001/12/17 09:24:05     1.2
***************
*** 2,9 ****
    (string-append filename ".lock"))
  
! (define (create-temp filename)
!  (create-temp-file filename))
! 
! (define (maybe-obtain-lock tempname filename)
   (let ((port (open-file tempname (bitwise-ior open/write 
                                              open/create 
--- 2,6 ----
    (string-append filename ".lock"))
  
! (define (maybe-obtain-dot-lock tempname filename)
   (let ((port (open-file tempname (bitwise-ior open/write 
                                              open/create 
***************
*** 19,23 ****
      #t)))
  
! (define (release-lock filename)
    (with-errno-handler
     ((errno packet)
--- 16,20 ----
      #t)))
  
! (define (release-dot-lock filename)
    (with-errno-handler
     ((errno packet)
***************
*** 26,50 ****
     #t))
  
! (define (obtain-lock filename)
!   (let ((tempname (create-temp filename)))
!     (delete-file tempname)
!     (let loop ()
!       (or (maybe-obtain-lock tempname filename)
!         (begin (sleep 1000)
!                (loop))))))
!       
! (define-syntax with-lock
!   (syntax-rules 
!    ()
!    ((with-lock filename body ...)
!     (with-handler
!      (lambda (condition more)
!        (release-lock filename)
!        (more))
       (lambda ()
!        (obtain-lock filename)
!        (call-with-values (lambda ()
!                          body ...)
                         (lambda a
!                          (release-lock filename)
!                          (apply values a))))))))
--- 23,56 ----
     #t))
  
! (define (obtain-dot-lock filename . args)
!   (let-optionals args ((retry-interval 1000) (retry-number #f))
!      (let ((tempname (create-temp-file filename)))
!        (delete-file tempname)
!        (let loop ((retry-number retry-number))
!        (or (maybe-obtain-dot-lock tempname filename)
!            (begin (sleep retry-interval)
!                   (cond ((not retry-number)
!                          (loop retry-number))
!                         ((> retry-number 0)
!                          (loop (- retry-number 1)))
!                         (else #f))))))))
! 
! (define (with-dot-lock* filename thunk)
!   (dynamic-wind
!      (lambda () 
!        (obtain-dot-lock filename))
       (lambda ()
!        (call-with-values thunk
                         (lambda a
!                          (release-dot-lock filename)
!                          (apply values a))))
!      (lambda ()
!        (release-dot-lock filename))))
! 
! (define-syntax with-dot-lock
!   (syntax-rules 
!    ()
!    ((with-dot-lock filename body ...)
!     (with-dot-lock* filename (lambda () body ...)))))
! 
! 

Index: scsh-interfaces.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/scsh-interfaces.scm,v
retrieving revision 1.28
retrieving revision 1.29
diff -C2 -r1.28 -r1.29
*** scsh-interfaces.scm 2001/12/03 15:21:46     1.28
--- scsh-interfaces.scm 2001/12/17 09:24:05     1.29
***************
*** 1082,1089 ****
          full-interrupt-set))
  
! (define-interface locks-interface
!   (export obtain-lock
!         release-lock
!         (with-lock :syntax)))
  
  (define-interface syslog-interface
--- 1082,1090 ----
          full-interrupt-set))
  
! (define-interface dot-locking-interface
!   (export obtain-dot-lock
!         release-dot-lock
!         (with-dot-lock :syntax)
!         with-dot-lock*))
  
  (define-interface syslog-interface
***************
*** 1118,1120 ****
          with-syslog-channel))
  
! 
--- 1119,1122 ----
          with-syslog-channel))
  
! (define-interface crypt-interface
!   (export crypt))
\ No newline at end of file

Index: scsh-package.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/scsh-package.scm,v
retrieving revision 1.31
retrieving revision 1.32
diff -C2 -r1.31 -r1.32
*** scsh-package.scm    2001/12/07 11:24:30     1.31
--- scsh-package.scm    2001/12/17 09:24:05     1.32
***************
*** 133,136 ****
--- 133,137 ----
                        string-ports-interface
                        syslog-interface
+                       crypt-interface
                        ))
     (scsh-level-0-internals (export set-command-line-args!
***************
*** 386,389 ****
--- 387,391 ----
                      char-predicates-interface; Urk -- Some of this is R5RS!
                      obsolete-char-set-interface
+                     dot-locking-interface
                      )
  
***************
*** 459,468 ****
    (files threads))
  
! (define-structure dot-locking locks-interface
!   (open scsh
        scheme
!       handle
        threads) ; sleep
!   (files dot-locking)) 
  
  (define-structures ((syslog syslog-interface)
--- 461,470 ----
    (files threads))
  
! (define-structure dot-locking dot-locking-interface
!   (open scsh-level-0
        scheme
!       let-opt
        threads) ; sleep
!   (files dot-locking))
  
  (define-structures ((syslog syslog-interface)