Locking and unlocking resources

The script presented today is very interesting, it permits to lock a variable (so any resource), to prevent access to other users.
The script is composed of a server (lock-server)and the client functions (try-obtain-lock and free-lock). Let's see how it works:
open a rebol console do the following script:

REBOL [
    Title: "REBOL Locking System"
    Date: 23-Jun-1999
    Version: 1
    File: %lock-file.r
    Author: "Cal Dixon"
    Rights: {
        Copyright (c) 1999 Caleb Dixon.   This version is free for ANY
        use.   Do whatever you want with it as long as you don't claim
        to have created this.
    }
    Usage: {
        Be sure to run the 'lock-server function in a separate rebol
        process before calling the other functions, they will fail if
        the server is not available.   Once the server is running, you
        can just "do %locker.r" then use 'get-lock and 'free-lock in
        any script that needs resource locking.
    }
    Purpose: {To provide functions for voluntary resource locking in rebol}
    Comment: {
      This version does not do enough error checking.   This will be
      fixed later.
    }
    Email: deadzaphod@hotmail.com
]
; change this line if you want to use a port other than 7007 for this service.
if not value? 'rebol-lock-port   [rebol-lock-port: 7007]
lock-server: func [{Handles requests to lock and unlock named resources.}][
    locks: make block! []
    listener: open/lines join tcp://: rebol-lock-port
    while [true] [
        conn: first listener
        wait conn
        req: load first conn
        if (= to-lit-word (pick req 1) 'lock) [
            if none? find locks (pick req 2) [ append locks reduce [ (pick req 2) true ] ]
        if (available: do rejoin ["locks/" (pick req 2) ]) [
            do rejoin [ "locks/" (pick req 2) ": false" ]
        ]
        insert conn rejoin ["[" available "]" ]
        ]
        if (= to-lit-word (pick req 1) 'free) [
            do rejoin [ "locks/" (pick req 2) ": true" ]
            insert conn "[true ]"
        ]
        close conn
    ]
]
try-obtain-lock: function ["Attempt to lock a named resource"
    whichword [word!] ] [] [
    conn: open/lines join tcp://localhost: rebol-lock-port
    insert conn rejoin [ "[lock " whichword "]" ]
    return do load first conn
]
get-lock: function [
    {Attempt to lock a named resource, and retry if it is not available}
    whichword [word!] retries [integer!] ] [gotit ] [
    while [ not (gotit: try-obtain-lock whichword) ] [
        if (retries < 1) [ return gotit ]
        retries: retries - 1
        wait 1
    ]
    gotit
]
free-lock: function ["Free a named resource" whichword [word!] ] [] [
  conn: open/lines join tcp://localhost: rebol-lock-port
  insert conn rejoin [ "[free " whichword "]" ]
  return do load first conn
]


then launch:

lock-server


Now open another rebol console, do the same script and try this:

>> a: "hello word"
== "hello word"
>> try-obtain-lock 'a
== true
>> try-obtain-lock 'a
== false
>> free-lock 'a
== true


As you noted, the first console check if some variable is locked and advice you. You can't obtain TRUE from try-to-obtain if the variable isn't freed.
Well, why is so interesting? The answer is that in a multiuser environment or working with databases, you must know if someone is working on a resource, and avoid job collisions.  Just image a webshop that it has just one item to sell and two users simultaneously order the item, only with locking you avoid mistakes.
Another great feature of this script is the client server configuration, this way you can work with multiple users, across internet, and create multithreads programs!!!