From aeb2d8ae5c23c4057ed17013f806bb94c3dd56e8 Mon Sep 17 00:00:00 2001 From: Alex Williams Date: Sat, 1 Aug 2020 02:27:08 +0000 Subject: [PATCH] Add many new commands and bug fixes (see CHANGELOG.md) --- CHANGELOG.md | 25 ++++ COMMANDS.md | 287 ++++++++++++++++++++++++++++++++++++++++++ README.md | 203 +++++++++--------------------- client.l | 75 +++++++---- clihelpers.l | 13 +- libkv.l | 255 ++++++++++++++++++++++++++++--------- libkvclient.l | 83 +++++++----- module.l | 2 +- test.l | 4 +- test/test_cs.l | 18 +-- test/test_kv.l | 122 ++++++++---------- test/test_kv_hashes.l | 114 +++++++++++++++++ test/test_kv_lists.l | 132 +++++++++++++++++++ 13 files changed, 991 insertions(+), 342 deletions(-) create mode 100644 COMMANDS.md create mode 100644 test/test_kv_hashes.l create mode 100644 test/test_kv_lists.l diff --git a/CHANGELOG.md b/CHANGELOG.md index 16d9e51..bb135cb 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,30 @@ # Changelog +## 0.16.0 (2020-08-17) + + ### New features + + * [commands] Add the following Hash COMMANDS: `HDEL, HEXISTS, HGET, HGETALL, HKEYS, HLEN, HMGET, HSET, HSTRLEN, HVALS` + * [commands] Add the following List COMMANDS: `LPUSH, LRANGE, LREM, LSET, LTRIM, RPOP, RPOPLPUSH` + * [commands] Add the following String COMMANDS: `APPEND, MSET, MGET, STRLEN` + * [client] Add `--commands` to view the list of all commands + * [client] Add `--encrypt` and `--decrypt` options to encrypt/decrypt data using a GPG keypair + * [client] Add `--` option to read last argument data from STDIN + + ### Bug fixes + + * Ensure listening on a socket will abort after `*KV_abort` seconds + * Reading frorm a socket shouldn't return "no data" or "unknown data" if there's no data. It should just print an empty string. + * Errors should throw/raise an error with the message, for the client to parse + * Perform more validations on individual commands, ex: ensuring a Key is a list, etc + * Temporarily disabled integrations tests because they cause false/positives + + ### Misc changes + + * Change the way IDENT and AUTH is performed in client and server + * Client doesn't print "OK " anymore for every command + * Simplify much of the kv command processing code + ## 0.15.1 (2020-07-31) * Move the global list of all keys to '%stats%/keys' so it can't be deleted or modified diff --git a/COMMANDS.md b/COMMANDS.md new file mode 100644 index 0000000..17a82c2 --- /dev/null +++ b/COMMANDS.md @@ -0,0 +1,287 @@ + +# List of commands + +Most `COMMANDS` take the exact same arguments, and return the same type of value, as their respective [Redis™ commands](https://redis.io/commands). + +| Command | Description | +| ---- | ---- | +| [APPEND](#append) key value | Append a value to a key | +| [BGSAVE](#bgsave) | Asynchronously save the dataset to disk | +| [CLIENT ID](#client-id) | Returns the client ID for the current connection | +| [CLIENT KILL ID](#client-kill-id) id [id ..] | Kill the connection of a client | +| [CLIENT LIST](#client-list) | Get the list of client connections | +| [CONVERT](#convert) | Convert a plaintext database to binary or vice-versa | +| [DEL](#del) key [key ..] | Delete one or more keys | +| [EXISTS](#exists) key [key ..] | Determine if a key exists | +| [GET](#get) key | Get the value of a key | +| [GETSET](#getset) key value | Set the string value of a key and return its old value | +| [HDEL](#hdel) key field [field ..] | Delete one or more hash fields | +| [HEXISTS](#hexists) key field | Determine if a hash field exists | +| [HGET](#hget) key field | Get the value of a hash field | +| [HGETALL](#hgetall) key | Get all the fields and values in a hash | +| [HKEYS](#hkeys) key | Get all the fields in a hash | +| [HLEN](#hlen) key | Get the number of fields in a hash | +| [HMGET](#hmget) key field [field ..] | Get the values of all the given hash fields | +| [HSET](#hset) key field value [field value ..] | Set the string value of a hash field | +| [HSTRLEN](#hstrlen) key field | Get the length of the value of a hash field | +| [HVALS](#hvals) key | Get all the values in a hash | +| [INFO](#info) [section] | Get information and statistics about the server | +| [LINDEX](#lindex) key index | Get an element from a list by its index | +| [LLEN](#llen) key | Get the length of a list | +| [LPOP](#lpop) key | Remove and get the first element in a list | +| [LPOPRPUSH](#lpoprpush) source destination | Remove the first element in a list, append it to another list and return it | +| [LPUSH](#lpush) key element [element ..] | Prepend one or multiple elements to a list | +| [LRANGE](#lrange) key start stop | Get a range of elements from a list | +| [LREM](#lrem) key count element | Remove elements from a list | +| [LSET](#lset) key index element | Set the value of an element in a list by its index | +| [LTRIM](#ltrim) key start stop | Trim a list to the specified range | +| [MGET](#mget) key [key ..] | Get the values of all the given keys | +| [MSET](#mset) key value [key value ..] | Set multiple keys to multiple values | +| [PING](#ping) [message] | Ping the server | +| [RPOP](#rpop) key | Remove and get the last element in a list | +| [RPOLRPUSH](#rpolrpush) source destination | Remove the last element in a list, prepend it to another list and return it | +| [RPUSH](#rpush) key element [element ..] | Append one or multiple elements to a list | +| [SAVE](#save) | Synchronously save the dataset to disk | +| [SET](#set) key value | Set the string value of a key | +| [STRLEN](#strlen) key | Get the length of the value stored in a key | + + +## APPEND + +#### APPEND key value + +If key already exists and is a string, this command appends the value at the end of the string. + +#### Return values + + * **Integer**: the length of the string after the append operation + * **NIL**: if key is not a string or does not exist + +#### CLI example + +```bash +./client.l --pass yourpass EXISTS mykey +0 +./client.l --pass yourpass SET mykey "Hello" +OK +./client.l --pass yourpass APPEND mykey " World" +11 +./client.l --pass yourpass GET mykey +Hello World +``` + +#### PicoLisp example + +```picolisp +: (kv-send-data '("EXISTS" "mykey")) +-> 0 +: (kv-send-data '("SET" "mykey" "Hello")) +-> "OK" +: (kv-send-data '("APPEND" "mykey" " World")) +-> 11 +: (kv-send-data '("GET" "mykey")) +-> "Hello World" +: (kv-send-data '("APPEND" "doesntexist" "test")) +-> NIL +``` + +## BGSAVE + +#### BGSAVE + +Save the DB in background. + +The KV server forks, the parent continues to serve the clients, the child saves the DB +on disk then exits. + +An error is returned if there is already a background save running or if there is another non-background-save process running. + +#### Return values + + * **String**: `Background saving started` if the `BGSAVE` started correctly or `Error: DB is locked for writing` if the DB is locked. + +#### CLI example + +```bash +./client.l --pass yourpass BGSAVE +Background saving started +``` + +#### PicoLisp example + +```picolisp +: (kv-send-data '("BGSAVE")) +-> "Background saving started" +``` +## CLIENT ID + +#### CLIENT ID + +The command just returns the ID of the current connection. Every connection ID has certain guarantees: + + 1. It is never repeated, so if `CLIENT ID` returns the same number, the caller can be sure that the underlying client did not disconnect and reconnect the connection, but it is still the same connection. + 2. The ID is monotonically incremental. If the ID of a connection is greater than the ID of another connection, it is guaranteed that the second connection was established with the server at a later time. + +#### Return values + + * **Integer**: The id of the client. + +#### CLI example + +```bash +./client.l --pass yourpass CLIENT ID +1 +./client.l --pass yourpass CLIENT ID +2 +``` + +#### PicoLisp example + +```picolisp +: (kv-send-data '("CLIENT" "ID")) +-> 3 +``` + +## CLIENT KILL ID + +#### CLIENT ID id [id ..] + +The command allows to end one or more client connections by their unique `ID` field. + +#### Return values + + * **String**: the number of clients connections ended. + +#### CLI example + +```bash +./client.l --pass yourpass CLIENT KILL ID 2 +1 +``` + +#### PicoLisp example + +```picolisp +: (kv-send-data '("CLIENT" "KILL" "ID" "2")) +-> 0 +``` + +## CLIENT LIST + +#### CLIENT LIST + +Returns information and statistics about the client connections server in a mostly human readable format. + +The KV server forks, the parent continues to serve the clients, the child saves the DB +on disk then exits. + +An error is returned if there is already a background save running or if there is another non-background-save process running. + +#### Return values + + * **Multi-line String**: a unique string, formatted as follows: + * One client connection per line (separated by `\n` newline/linefeed) + * Each line is composed of a succession of `property=value` fields separated by a space character. + +Here is the meaning of the fields: + +* `id`: a unique auto-incrementing 64-bit client ID +* `pid`: process ID of the forked child handling the request +* `name`: name set by the client, with `--name` or autogenerated +* `addr`: address of the client +* `port`: source port of the client +* `fd`: file descriptor corresponding to the socket + +#### CLI example + +```bash +./client.l --pass yourpass CLIENT LIST +id=1 pid=16929 name=4AF35825 addr=::1 port=49774 fd=7 +``` + +#### PicoLisp example + +```picolisp +: (kv-send-data '("CLIENT" "LIST")) +-> "id=2 pid=10019 name=79738D13 addr=::1 port=50956 fd=7" +``` + +## CONVERT + +#### CONVERT + +Convert a plaintext database to binary or vice-versa. + +The KV server by default saves data on disk in plaintext format, which can be modified by hand by anyone with practically no PicoLisp knowledge. The disadvantage with plaintext is its on-disk footprint is quite large compared to binary. For small datasets the difference is negligible, but it could also affect performance when first loading the database. + +While the server is running, it is possible to dump the database to disk using a different format, for example: if it's currently saving in plaintext, `CONVERT` will dump it to disk in binary. All future saves will also be in binary until the server is restarted, or until another `CONVERT` command is sent (which would convert it back to plaintext). + +Using the CLI tool: + + * The default filename for binary format is `kv.bin`. + * The default filename for plaintext format is `kv.db`. + +Using the PicoLisp server library `libkv.l`: + +The database filename can be changed through the `*KV_db` variable, example `(setq *KV_db "/path/to/db.bin")` + + * To enable `binary` saving in PicoLisp, use `(on *KV_binary)` + * To disable `binary` saving in PicoLisp, use `(off *KV_binary)` + +#### Return values + + * **String**: `OK` if the database was converted successfully. + +#### CLI example + +```bash +./client.l --pass yourpass CONVERT +OK +``` + +#### PicoLisp example + +```picolisp +: (kv-send-data '("CONVERT")) +-> "OK" +``` + +## DEL + +#### DEL key [key ..] + +Removes the specified keys. All given keys are removed whether they exist or not. + +#### Return values + + * **Integer**: The number of keys that were removed. + +#### CLI example + +```bash +./client.l --pass yourpass SET key1 "Hello" +OK +./client.l --pass yourpass SET key2 "World" +OK +./client.l --pass yourpass DEL key1 key2 key3 +3 +``` + +#### PicoLisp example + +```picolisp +: (kv-send-data '("SET" "key1" "Hello")) +-> "OK" +: (kv-send-data '("SET" "key2" "World")) +-> "OK" +: (kv-send-data '("DEL" "key1" "key2" "key3")) +-> 3 +``` + +# License + +This documentation copies in part the [Redis documentation](https://github.com/redis/redis-io), distributed under the [Creative Commons Attribution-ShareAlike 4.0 International license](https://creativecommons.org/licenses/by-sa/4.0/) license, and is modified to match the [PicoLisp KV](https://github.com/aw/picolisp-kv) library code. + +This documentation is licensed under [Creative Commons Attribution-ShareAlike 4.0 International (CC BY-SA 4.0)](https://creativecommons.org/licenses/by-sa/4.0/). + +Copyright (c) 2020 Alexander Williams, On-Prem diff --git a/README.md b/README.md index 563a50f..9493271 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,8 @@ # Redis-inspired key/value store written in PicoLisp -This program mimics functionality of a [Redis](https://redis.io) in-memory database, but is designed specifically for [PicoLisp](https://picolisp.com) applications with optional on-disk persistence. +This program mimics functionality of a [Redis™](https://redis.io) in-memory database, but is designed specifically for [PicoLisp](https://picolisp.com) applications with optional on-disk persistence and encryption. + +> **Note:** This library **DOES NOT** use the [RESP protocol](https://redis.io/topics/protocol) and thus cannot work with the `redis-cli` or other _Redis_ clients/servers. The included `server.l` and `client.l` can be used to send and receive _"Redis-like"_ commands over TCP or UNIX named pipess. @@ -15,7 +17,8 @@ The included `server.l` and `client.l` can be used to send and receive _"Redis-l 7. [Testing](#testing) 8. [Contributing](#contributing) 9. [Changelog](#changelog) - 10. [License](#license) + 10. [Notice](#notice) + 11. [License](#license) # Requirements @@ -122,158 +125,62 @@ The client handles authentication, identification, and sending of _"Redis-like"_ # client.l Usage: ./client.l --pass COMMAND [arguments] -Example: ./client.l --pass foobared --port 6378 INFO server +Example: ./client.l --pass foobared --encrypt SET mysecret -- <(echo 'mypass') Options: --help Show this help message and exit +--commands Show the full list of commands and exit ---name Easily identifiable client name (default: randomly generated) +--decrypt Enable decryption of values using a GPG public key (default: disabled) +--encrypt Enable encryption of values using a GPG public key (default: disabled) +--name Easily identifiable client name (default: randomly generated) --host Hostname or IP of the key/value server (default: localhost) --pass Password used to access the server (required) --poll Number of seconds for polling the key/value server (default: don't poll) --port TCP port of the key/value server (default: 6378) - -COMMAND LIST Commands are case-insensitive and don't always require arguments. - Examples: - -BGSAVE BGSAVE -CLIENT ID|KILL|LIST id [id ..] CLIENT LIST -CONVERT CONVERT -DEL key [key ..] DEL key1 key2 key3 -EXISTS key [key ..] EXISTS key1 key2 key3 -GET key GET key1 -GETSET key value GETSET mykey hello -INFO [section] INFO memory -LINDEX key index LINDEX mylist 0 -LLEN key LLEN mylist -LPOP key LPOP mylist -LPOPRPUSH source destination LPOPRPUSH mylist myotherlist -PING [message] PING hello -RPUSH key element [element ..] RPUSH mylist task1 task2 task3 -SAVE SAVE -SET key value SET mykey hello -``` - -Most `COMMANDS` take the exact same arguments as their respective [Redis commands](https://redis.io/commands). - -### Examples - -``` -# Obtain information about the server -./client.l --pass yourpass INFO server -OK 37D13779 - -# Server -app_version:0.11.0 -os:Linux 4.19.34-tinycore64 x86_64 -arch_bits:64 -process_id:38874 -tcp_port:6378 -uptime_in_seconds:1 -uptime_in_days:0 -executable:/usr/bin/picolisp - -# Set a key -./client.l --pass yourpass SET mykey myvalue -OK 53E02FC6 -OK - -# Get a key -./client.l --pass yourpass GET mykey -OK 40E83305 -myvalue - -# Get a key, then set it -./client.l --pass yourpass GETSET mykey yourvalue -OK 69E88646 -myvalue - -# Check if a key exists -./client.l --pass yourpass EXISTS mykey -OK 43BFA2C -1 - -# Delete a key -./client.l --pass yourpass DEL mykey -OK 4C2B6088 -1 - -./client.l --pass yourpass GET mykey -OK 11242B95 -no data - -./client.l --pass yourpass EXISTS mykey -OK 5F1E8D78 -0 - -# Add multiple values to a key (a list) -./client.l --pass yourpass --name 11242B95 RPUSH mylist task1 task2 task3 -OK 11242B95 -3 - -./client.l --pass yourpass RPUSH mylist task4 task5 -OK 4E7E0FC3 -5 - -# Left pop a value from the head of a list -./client.l --pass yourpass LPOP mylist -OK 258514BF -task1 - -# Check how many values are in a key (a list) -./client.l --pass yourpass LLEN mylist -OK 107CF205 -4 - -# Left pop a value from the head of a list, push it to the tail of another list -./client.l --pass yourpass LPOPRPUSH mylist mynewlist -OK 46028880 -task2 - -# Get the value of a key (a list) using a zero-based index -./client.l --pass yourpass LINDEX mynewlist -1 -OK 129AE0F8 -task2 - -# Ping the server -./client.l --pass yourpass PING -OK 6DCE69EB -PONG - -# Ping the server with a custom message -./client.l --pass yourpass PING "Hello" -OK 6F02D9DC -Hello - -# Save the database in the foreground (blocking) -./client.l --pass yourpass SAVE -OK 1F60EABE -OK - -# Save the database in the background (non-blocking) -./client.l --pass yourpass BGSAVE -OK 1270937D -Background saving started - -# Convert the database from plaintext to binary, or binary to plaintext -./client.l --pass yourpass CONVERT -OK 25E3B970 -OK - -# Get the list of connected clients -./client.l --pass yourpass CLIENT LIST -OK 6FC82046 -id=2 pid=26377 name=6FC82046 addr=::1 fd=7 -id=1 pid=26370 name=783EABE1 addr=::1 fd=7 - -# Get the current client ID -./client.l --pass yourpass CLIENT ID -OK 105ECBFE - -# Stop and kill a client connection -./client.l --pass yourpass CLIENT KILL ID 1 -OK 32CA1C8A -1 +-- STDIN Reads an argument from STDIN + +COMMAND LIST Commands are case-insensitive and don't always require arguments + + APPEND key value Append a value to a key + BGSAVE Asynchronously save the dataset to disk + CLIENT ID Returns the client ID for the current connection + CLIENT KILL ID id [id ..] Kill the connection of a client + CLIENT LIST Get the list of client connections + CONVERT Convert a plaintext database to binary or vice-versa + DEL key [key ..] Delete a key + EXISTS key [key ..] Determine if a key exists + GET key Get the value of a key + GETSET key value Set the string value of a key and return its old value + HDEL key field [field ..] Delete one or more hash fields + HEXISTS key field Determine if a hash field exists + HGET key field Get the value of a hash field + HGETALL key Get all the fields and values in a hash + HKEYS key Get all the fields in a hash + HLEN key Get the number of fields in a hash + HMGET key field [field ..] Get the values of all the given hash fields + HSET key field value [field value ..] Set the string value of a hash field + HSTRLEN key field Get the length of the value of a hash field + HVALS key Get all the values in a hash + INFO [section] Get information and statistics about the server + LINDEX key index Get an element from a list by its index + LLEN key Get the length of a list + LPOP key Remove and get the first element in a list + LPOPRPUSH source destination Remove the first element in a list, append it to another list and return it + LPUSH key element [element ..] Prepend one or multiple elements to a list + LRANGE key start stop Get a range of elements from a list + LREM key count element Remove elements from a list + LSET key index element Set the value of an element in a list by its index + LTRIM key start stop Trim a list to the specified range + MGET key [key ..] Get the values of all the given keys + MSET key value [key value ..] Set multiple keys to multiple values + PING [message] Ping the server + RPOP key Remove and get the last element in a list + RPOLRPUSH source destination Remove the last element in a list, prepend it to another list and return it + RPUSH key element [element ..] Append one or multiple elements to a list + SAVE Synchronously save the dataset to disk + SET key value Set the string value of a key + STRLEN key Get the length of the value stored in a key ``` # Notes and limitations @@ -432,6 +339,10 @@ This library comes with a large suite of [unit and integration tests](https://gi [Changelog](CHANGELOG.md) +# Notice + +* Redis is a trademark of Redis Labs Ltd. Any rights therein are reserved to Redis Labs Ltd. Any use by me is for referential purposes only and does not indicate any sponsorship, endorsement or affiliation between Redis and me. + # License [MIT License](LICENSE) diff --git a/client.l b/client.l index 762c308..eb52a8e 100755 --- a/client.l +++ b/client.l @@ -7,33 +7,62 @@ [de APP_HELP ("usage" "./client.l --pass COMMAND [arguments]") - ("example" "./client.l --pass foobared --port 6378 INFO server^J") + ("example" "./client.l --pass foobared --encrypt SET mysecret -- <(echo 'mypass')^J") ("options" ("--help" "Show this help message and exit") + ("--commands" "Show the full list of commands and exit") () - ("--name " "Easily identifiable client name (default: randomly generated)") + ("--decrypt" "Enable decryption of values using a GPG public key (default: disabled)") + ("--encrypt" "Enable encryption of values using a GPG public key (default: disabled)") + ("--name " "Easily identifiable client name (default: randomly generated)") ("--host " "Hostname or IP of the key/value server (default: localhost)") ("--pass " "Password used to access the server (required)") ("--poll " "Number of seconds for polling the key/value server (default: don't poll)") ("--port " "TCP port of the key/value server (default: 6378)") + ("-- STDIN" "Reads an argument from STDIN") () - ("COMMAND LIST" "Commands are case-insensitive and don't always require arguments.^J^I^I^I^I^IExamples:") + ("COMMAND LIST" "Use '--commands' to see the full list of commands") ) + ("commands" + ("COMMAND LIST" "Commands are case-insensitive and don't always require arguments") () - (" BGSAVE" "^I^IBGSAVE") - (" CLIENT ID|KILL|LIST id [id ..]" "^ICLIENT LIST") - (" CONVERT" "^I^ICONVERT") - (" DEL key [key ..]" "^I^IDEL key1 key2 key3") - (" EXISTS key [key ..]" "^I^IEXISTS key1 key2 key3") - (" GET key" "^I^IGET key1") - (" GETSET key value" "^I^IGETSET mykey hello") - (" INFO [section]" "^I^IINFO memory") - (" LINDEX key index" "^I^ILINDEX mylist 0") - (" LLEN key" "^I^ILLEN mylist") - (" LPOP key" "^I^ILPOP mylist") - (" LPOPRPUSH source destination" "^ILPOPRPUSH mylist myotherlist") - (" PING [message]" "^I^IPING hello") - (" RPUSH key element [element ..]" "^IRPUSH mylist task1 task2 task3") - (" SAVE" "^I^ISAVE") - (" SET key value" "^I^ISET mykey hello") ] + ("APPEND key value" "^I^IAppend a value to a key") + ("BGSAVE" "^I^IAsynchronously save the dataset to disk") + ("CLIENT ID" "^I^IReturns the client ID for the current connection") + ("CLIENT KILL ID id [id ..]" "^I^IKill the connection of a client") + ("CLIENT LIST" "^I^IGet the list of client connections") + ("CONVERT" "^I^IConvert a plaintext database to binary or vice-versa") + ("DEL key [key ..]" "^I^IDelete a key") + ("EXISTS key [key ..]" "^I^IDetermine if a key exists") + ("GET key" "^I^IGet the value of a key") + ("GETSET key value" "^I^ISet the string value of a key and return its old value") + ("HDEL key field [field ..]" "^I^IDelete one or more hash fields") + ("HEXISTS key field" "^I^IDetermine if a hash field exists") + ("HGET key field" "^I^IGet the value of a hash field") + ("HGETALL key" "^I^IGet all the fields and values in a hash") + ("HKEYS key" "^I^IGet all the fields in a hash") + ("HLEN key" "^I^IGet the number of fields in a hash") + ("HMGET key field [field ..]" "^IGet the values of all the given hash fields") + ("HSET key field value [field value ..] Set the string value of a hash field") + ("HSTRLEN key field" "^I^IGet the length of the value of a hash field") + ("HVALS key" "^I^IGet all the values in a hash") + ("INFO [section]" "^I^IGet information and statistics about the server") + ("LINDEX key index" "^I^IGet an element from a list by its index") + ("LLEN key" "^I^IGet the length of a list") + ("LPOP key" "^I^IRemove and get the first element in a list") + ("LPOPRPUSH source destination" "^IRemove the first element in a list, append it to another list and return it") + ("LPUSH key element [element ..]" "^IPrepend one or multiple elements to a list") + ("LRANGE key start stop" "^I^IGet a range of elements from a list") + ("LREM key count element" "^I^IRemove elements from a list") + ("LSET key index element" "^I^ISet the value of an element in a list by its index") + ("LTRIM key start stop" "^I^ITrim a list to the specified range") + ("MGET key [key ..]" "^I^IGet the values of all the given keys") + ("MSET key value [key value ..]" "^ISet multiple keys to multiple values") + ("PING [message]" "^I^IPing the server") + ("RPOP key" "^I^IRemove and get the last element in a list") + ("RPOLRPUSH source destination" "^IRemove the last element in a list, prepend it to another list and return it") + ("RPUSH key element [element ..]" "^IAppend one or multiple elements to a list") + ("SAVE" "^I^ISynchronously save the dataset to disk") + ("SET key value" "^I^ISet the string value of a key") + ("STRLEN key" "^I^IGet the length of the value stored in a key") ] (chdir (car (file)) (load "libkvclient.l" "clihelpers.l" "module.l")) @@ -43,18 +72,22 @@ (while (opt) (case @ (--help (kv-show-help) (bye 1)) + (--commands (kv-show-commands) (bye 1)) + (--decrypt (on *KV_decrypt)) # decrypt all values using GPG + (--encrypt (on *KV_encrypt)) # encrypt all values using GPG (--host (setq *KV_host (opt))) # default 'localhost' (--port (setq *KV_port (opt))) # default '6378' (--name (setq *KV_clientid (opt))) # default '' (--poll (setq *KV_poll (opt))) # enable polling of command (--pass (setq *KV_pass (opt))) # required password + (-- (queue '*Cmdargs (in (opt) (line T)))) # reads the argument from STDIN (T (queue '*Cmdargs @)) ) ) # save remaining cmdline arguments (finally - (unless (=T @) (bye 1)) + (when *Msg (bye 1)) (catch 'kv-error (when (kv-start-client) - (kv-print @) + #(kv-print @) # don't print the "OK " reply (if *KV_poll (loop (NIL (when (kv-send-data *Cmdargs) diff --git a/clihelpers.l b/clihelpers.l index 0bbeecb..fd207fd 100644 --- a/clihelpers.l +++ b/clihelpers.l @@ -9,13 +9,22 @@ [de kv-options (N) (tab (2 -22 5) " " (car N) (cdr N) ] -[de kv-show-help () +[de kv-show-commands () + (kv-show-header) + (prinl + (mapcar kv-options (cdr (assoc "commands" APP_HELP) ] + +[de kv-show-header () (prinl (cdr (assoc "name" APP_INFO)) " v" (cdr (assoc "version" APP_INFO)) "^J" "Copyright " (cdr (assoc "copyright" APP_INFO)) "^J" (cdr (assoc "source" APP_INFO)) "^J" "License " (cdr (assoc "license" APP_INFO)) "^J^J" - (cdr (assoc "summary" APP_INFO)) "^J^J" + (cdr (assoc "summary" APP_INFO)) "^J" ] + +[de kv-show-help () + (kv-show-header) + (prinl (kv-options (list "Usage:" (cdr (assoc "usage" APP_HELP)))) "^J" (kv-options (list "Example:" (cdr (assoc "example" APP_HELP)))) (kv-options (list "Options:")) diff --git a/libkv.l b/libkv.l index 2a75d59..3ce3b8e 100644 --- a/libkv.l +++ b/libkv.l @@ -21,7 +21,8 @@ *KV_aof_lock (tmp "kv.aof.lock") *KV_aof_tmp (tmp "kv.aof.tmp") *KV_db_lock (tmp "kv.db.lock") - *KV_db_tmp (tmp "kv.db.tmp") ) + *KV_db_tmp (tmp "kv.db.tmp") + *KV_write_commands '("APPEND" "DEL" "GETSET" "HDEL" "HSET" "LPOP" "LPOPRPUSH" "LPUSH" "LREM" "LSET" "LTRIM" "MSET" "RPOP" "RPOPLPUSH" "RPUSH" "SET") ) # INITIALIZE (off *KV/%stats%/connected_clients *KV/%stats%/rdb_last_bgsave_status) @@ -48,47 +49,76 @@ ### [de kv-process (Child Request) - (let Key (when (cadr Request) (kv-name (cadr Request))) + (let (Key (caadr Request) + Value (cadadr Request) ) + (case (uppc (car Request)) + ["APPEND" (kv-cmd-append Key Value) ] ["BGSAVE" (kv-bgsave-db *Aof_desc) ] - ["CLIENT" (kv-cmd-client Child (cdr Request) ] + ["CLIENT" (kv-cmd-client Child (cadr Request) ] ["CONVERT" (kv-cmd-convert) ] - ["DEL" (kv-cmd-del (cadr Request) (; Request 3) ] - ["EXISTS" (kv-cmd-exists (cadr Request) (; Request 3) ] - ["GET" (kv-cmd-get (cadr Request) ] - ["GETSET" (kv-cmd-getset (cadr Request) (; Request 3) ] + ["DEL" (kv-cmd-del Key (cdadr Request) ] + ["EXISTS" (kv-cmd-exists Key (cdadr Request) ] + ["GET" (kv-cmd-get Key) ] + ["GETSET" (kv-cmd-getset Key Value) ] + ["HDEL" (kv-cmd-hdel Key (cdadr Request) ] + ["HEXISTS" (kv-cmd-hexists Key Value) ] + ["HGET" (kv-cmd-hget Key Value) ] + ["HGETALL" (kv-cmd-hgetall Key) ] + ["HKEYS" (kv-cmd-hkeys Key) ] + ["HLEN" (kv-cmd-hlen Key) ] + ["HMGET" (kv-cmd-hmget Key (cdadr Request) ] + ["HSET" (kv-cmd-hset Key (cdadr Request) ] + ["HSTRLEN" (kv-cmd-hstrlen Key Value) ] + ["HVALS" (kv-cmd-hvals Key) ] ["IDENT" (kv-cmd-ident Child (cdr Request) ] - ["INFO" (kv-cmd-info (cadr Request) ] - ["LINDEX" (kv-cmd-lindex Key (; Request 3) ] - ["LLEN" (kv-cmd-llen Key) ] + ["INFO" (kv-cmd-info Key) ] + ["LINDEX" (kv-cmd-lindex Key (format Value) ] + ["LLEN" (kv-cmd-strlen Key) ] ["LPOP" (kv-cmd-lpop Key) ] - ["LPOPRPUSH" (kv-cmd-lpoprpush Key (; Request 3) ] - ["PING" (kv-cmd-ping (cadr Request) ] - ["RPUSH" (kv-cmd-rpush (cadr Request) Key (; Request 3) ] + ["LPOPRPUSH" (kv-cmd-lpoprpush Key Value) ] + ["LPUSH" (kv-cmd-lpush Key (cdadr Request) ] + ["LRANGE" (kv-cmd-lrange Key (format Value) (format (; (cadr Request) 3) ] + ["LREM" (kv-cmd-lrem Key (format Value) (; (cadr Request) 3) ] + ["LSET" (kv-cmd-lset Key (format Value) (; (cadr Request) 3) ] + ["LTRIM" (kv-cmd-ltrim Key (format Value) (format (; (cadr Request) 3) ] + ["MGET" (kv-cmd-mget (cadr Request) ] + ["MSET" (kv-cmd-mset (cadr Request) ] + ["PING" (kv-cmd-ping Key) ] + ["RPOP" (kv-cmd-rpop Key) ] + ["RPOPLPUSH" (kv-cmd-rpoplpush Key Value) ] + ["RPUSH" (kv-cmd-rpush Key (cdadr Request) ] ["SAVE" (kv-save-db) ] - ["SET" (kv-cmd-set (cadr Request) (; Request 3) ] + ["SET" (kv-cmd-set Key Value) ] + ["STRLEN" (kv-cmd-strlen Key) ] [T "Error: Unknown command" ] ] [de kv-cmd-flushall () (mapcar '((N) (off (kv-name N))) Keys) ] +[de kv-cmd-append (Key Value) + (when (and (kv-check-key Key 'str) Value) + (set (kv-name Key) (pack (kv-value Key) Value)) + (push1 (kv-name "%stats%/keys") Key) + (length (kv-value Key) ] + [de kv-cmd-client (Child Cmd) (case (uppc (car Cmd)) ("ID" (kv-cmd-client-id Child)) - ("KILL" (kv-cmd-client-kill (; Cmd 2) (; Cmd 3))) + ("KILL" (kv-cmd-client-kill (; Cmd 2) (format (; Cmd 3)))) ("LIST" (kv-cmd-client-list)) (T "Error: Unknown client command") ] [de kv-cmd-client-id (Child) - (cdr (assoc "id" (cadr (assoc Child (get (kv-value "%stats%/connected_clients") ] + (cdr (assoc "id" (cadr (assoc Child (kv-value "%stats%/connected_clients") ] [de kv-cmd-client-kill (Filter Arg) (case (uppc Filter) - ["ID" (length (make (mapcar '((N) (when (= Arg (cdr (assoc "id" (cadr N)))) (kv-remove-client (car N) T) (link T))) (get (kv-value "%stats%/connected_clients") ] + ["ID" (length (make (mapcar '((N) (when (= Arg (cdr (assoc "id" (cadr N)))) (kv-remove-client (car N) T) (link T))) (kv-value "%stats%/connected_clients") ] (T 0) ] [de kv-cmd-client-list () - (glue "^J" (mapcar '((N) (glue " " (mapcar '((S) (pack (car S) "=" (cdr S))) (cadr N)))) (get (kv-value "%stats%/connected_clients") ] + (glue "^J" (mapcar '((N) (glue " " (mapcar '((S) (pack (car S) "=" (cdr S))) (cadr N)))) (kv-value "%stats%/connected_clients") ] # convert a database to/from plaintext<->binary [de kv-cmd-convert () @@ -96,8 +126,9 @@ (setq *KV_db (pack (dirname *KV_db) (glue "." (append (head -1 (split (chop *KV_db) ".")) (if *KV_binary '(("b" "i" "n")) '(("d" "b"))))))) (kv-save-db) ] +# TODO: optimize the mass delete of keys [de kv-cmd-del (Key Elements) - (if (and Key (not (pre? "%stats%/" Key))) + (if (kv-check-key Key) (length (wipe (extract '((N) (unless (pre? "%stats%/" N) (kv-name N))) (conc (list Key) Elements)))) 0 ] # return 0 if no key is specified @@ -106,10 +137,68 @@ (cnt '((N) (kv-value N)) (conc (list Key) Elements)) 0 ] # return 0 if no key is specified +[de kv-cmd-get (Key) + (kv-value Key) ] + +[de kv-cmd-getset (Key Value) + (swap (kv-name Key) Value) ] + +[de kv-cmd-hdel (Key Elements) + (when (and (kv-check-key Key 'lst) Elements (lst? Elements)) + (length + (extract '((N) + (when (assoc N (kv-value Key)) (set (kv-name Key) (delete @ (kv-value Key))) T) ) + Elements ] + +[de kv-cmd-hexists (Key Field) + (if (assoc Field (kv-value Key)) + 1 + 0 ] + +[de kv-cmd-hget (Key Field) + (cdr (assoc Field (kv-value Key) ] + +[de kv-cmd-hgetall (Key) + (when (kv-check-key Key 'lst) + (extract '((N) (when (lst? N) N)) (kv-value Key) ] + +[de kv-cmd-hkeys (Key) + (when (kv-check-key Key 'lst) + (extract '((N) (when (lst? N) (car N))) (kv-value Key) ] + +[de kv-cmd-hlen (Key) + (when (kv-check-key Key 'lst) + (length (kv-value Key) ] + +[de kv-cmd-hmget (Key Elements) + (mapcar '((N) (kv-cmd-hget Key N)) Elements) ] + +[de kv-cmd-hset (Key Elements) + (use *Num + (zero *Num) + (when (and (kv-check-key Key 'lst) Elements (lst? Elements)) + [while (cut 2 'Elements) + (let Str @ + (when (cadr Str) + (inc '*Num) + (if (assoc (car Str) (kv-value Key)) + (kv-cmd-set Key (replace (kv-value Key) @ (cons (car Str) (cadr Str)))) + (kv-cmd-set Key (append (kv-value Key) (list (cons (car Str) (cadr Str) ] + *Num ] + +[de kv-cmd-hstrlen (Key Field) + (when (kv-check-key Key 'lst) + (length (cdr (assoc Field (kv-value Key) ] + +[de kv-cmd-hvals (Key) + (when (kv-check-key Key 'lst) + (extract '((N) (when (lst? N) (cdr N))) (kv-value Key) ] + [de kv-cmd-ident (Child Elements) (when (and Child Elements (lst? Elements)) # NIL if the IDENT isn't a list [push1 '*KV/%stats%/connected_clients # only add unique clients to the list (list Child (append (list (cons "id" (inc '*KV/%stats%/last_client)) (cons "pid" Child)) Elements) ] + (inc '*KV/%stats%/total_connections_received) (pack "OK " (cdr (assoc "name" Elements) ] [de kv-cmd-info (Section) @@ -121,45 +210,98 @@ ["stats" (kv-info-format "Stats" (kv-info-stats) ] (T (kv-info-default) ] -[de kv-cmd-lindex (Src Index) - (when (and Src (num? Index)) - (cond - ((= -1 Index) (last (car Src))) - ((lt0 Index) (last (head (+ 1 Index) (car Src)))) - (T (get (car Src) (+ 1 Index) ] +[de kv-cmd-lindex (Key Index) + (let Src (kv-name Key) + (when (and (kv-check-key Key 'lst) Index (num? Index)) + (cond + ((= -1 Index) (last (car Src))) + ((lt0 Index) (last (head (+ 1 Index) (car Src)))) + (T (get (car Src) (+ 1 Index) ] -[de kv-cmd-llen (Key) - (length (car Key) ] - -[de kv-cmd-lpop (Src) - (when (and Src (not (pre? "*KV/%stats%/" Src))) (pop Src) ] +[de kv-cmd-lpop (Key) + (let Src (kv-name Key) + (when (kv-check-key Key 'lst) (pop Src) ] [de kv-cmd-lpoprpush (Src Dst) - (when (and Src Dst (not (pre? "*KV/%stats%/" Src)) (not (pre? "%stats%/" Dst)) (pop Src)) + (when (and (kv-check-key Src 'lst) (kv-check-key Dst) (kv-cmd-lpop Src)) (let Result @ - (kv-cmd-rpush Dst (kv-name Dst) (list Result)) + (kv-cmd-rpush Dst (list Result)) + Result ] + +[de kv-cmd-lpush (Key Elements) + (when (and (kv-check-key Key 'lst) Elements (lst? Elements)) + (kv-cmd-set Key (append (reverse Elements) (kv-value Key))) + (length (kv-value Key) ] + +[de kv-cmd-lrange (Key Start Stop) + (let Src (kv-name Key) + (when (and (kv-check-key Key 'lst) Start Stop (ge0 Start) (ge0 Stop)) + (head (+ 1 (- Stop Start)) (nth (kv-value Key) (+ 1 Start) ] + +[de kv-cmd-lrem (Key Count Element) + (let Src (kv-name Key) + (if (and (kv-check-key Key 'lst) Count Element (ge0 Count)) + (let Len (length (kv-value Key)) + (cond + ((= 0 Count) (del Element Src T)) + (T (do Count (del Element Src))) ) + (- Len (length (kv-value Key))) ) + 0 ] + +[de kv-cmd-lset (Key Index Element) + (let Src (kv-name Key) + (when (and (kv-check-key Key 'lst) Index Element (ge0 Index) (< Index (length (kv-value Key)))) + (kv-cmd-set Key (place (+ 1 Index) (kv-value Key) Element) ] + +[de kv-cmd-ltrim (Key Start Stop) + (let Src (kv-name Key) + (when (and (kv-check-key Key 'lst) Start Stop (ge0 Start) (ge0 Stop)) + (kv-cmd-set Key (head (+ 1 (- Stop Start)) (nth (kv-value Key) (+ 1 Start) ] + +[de kv-cmd-mget (Elements) + (mapcar kv-cmd-get Elements) ] + +[de kv-cmd-mset (Elements) + (when (and Elements (lst? Elements)) + (while (cut 2 'Elements) + (let Str @ + (kv-cmd-set (car Str) (cadr Str)) ) ) + "OK" ] + +[de kv-cmd-rpoplpush (Src Dst) + (when (and (kv-check-key Src 'lst) (kv-check-key Dst) (kv-cmd-rpop Src)) + (let Result @ + (kv-cmd-lpush Dst (list Result)) Result ] [de kv-cmd-ping (Msg) (if Msg @ "PONG") ] -[de kv-cmd-rpush (Key Dst Elements) - (when (and Dst Elements (lst? Elements) (not (pre? "%stats%/" Key))) +[de kv-cmd-rpop (Key) + (let Src (kv-name Key) + (when (kv-check-key Key 'lst) (rot (kv-value Key)) (pop Src) ] + +[de kv-cmd-rpush (Key Elements) + (when (and (kv-check-key Key 'lst) Elements (lst? Elements)) (kv-cmd-set Key (append (kv-value Key) Elements)) - (length (car Dst) ] + (length (kv-value Key) ] [de kv-cmd-set (Key Value) - (when (and Key Value (not (pre? "%stats%/" Key)) (set (kv-name Key) Value)) + (when (and (kv-check-key Key) Value (set (kv-name Key) Value)) (push1 (kv-name "%stats%/keys") Key) # keep a list of all the keys "OK" ] -[de kv-cmd-get (Key) - (kv-value Key) ] +[de kv-cmd-strlen (Key) + (when Key + (length (kv-value Key) ] -[de kv-cmd-getset (Key Value) - (let Result (kv-cmd-get Key) - (kv-cmd-set Key Value) - Result ] +[de kv-check-key (Key Type) + (and Key (not (pre? "%stats%/" Key)) + (case Type + ("lst" (lst? (kv-value Key))) + ("str" (str? (kv-value Key))) + ("num" (num? (kv-value Key))) + (T T) ] [de kv-name (Name) (any (pack "*KV/" Name) ] @@ -210,7 +352,7 @@ (list (cons "db_format" (if *KV_binary "binary" "plaintext")) (cons "loading" *KV/%stats%/loading) - (cons "rdb_changes_since_last_save" (if (info *KV_aof) (lines *KV_aof) 0)) + (cons "rdb_changes_since_last_save" (if (info *KV_aof) (in (list 'wc "-l" *KV_aof) (read)) 0)) (cons "rdb_bgsave_in_progress" (if (info *KV_db_lock) 1 0)) (cons "rdb_last_save_time" *KV/%stats%/rdb_last_save_time) (cons "rdb_last_bgsave_status" *KV/%stats%/rdb_last_bgsave_status) @@ -224,7 +366,7 @@ [de kv-info-stats () (list - (cons "total_connections_received" (length *KV/%stats%/total_connections_received)) + (cons "total_connections_received" *KV/%stats%/total_connections_received) (cons "total_commands_processed" *KV/%stats%/total_commands_processed) (cons "total_net_input_bytes" *KV/%stats%/total_net_input_bytes) (cons "total_net_output_bytes" *KV/%stats%/total_net_output_bytes) @@ -273,7 +415,7 @@ # Write data to the DB, then write the AOF (truncate or wipe) [de kv-write-data (Bg) - (and (info *KV_db_tmp) (gt0 (car @)) (kv-write-db) (kv-remove-aof Bg) ] + (and (info *KV_db_tmp) (kv-write-db) (kv-remove-aof Bg) ] # Write the data in binary PLIO (pr) or plaintext (println) format [de kv-save-data (Key) @@ -380,7 +522,7 @@ # Save a write command to the append-only log file with a timestamp and hash of the data [de kv-save-aof (Request Aof) # Aof is a file descriptor - (when (member (car Request) '("DEL" "GETSET" "LPOP" "LPOPRPUSH" "RPUSH" "SET")) + (when (member (car Request) *KV_write_commands) (ctl *KV_aof_lock # try to obtain an exclusive lock (out Aof (println (list (kv-timestamp T) (kv-hash Request) Request))) (kv-stat "aof_last_write_status" (if @ "OK" "FAILED") ] @@ -398,7 +540,7 @@ # Receive a message from a sibling over a named pipe and send it to the client [de kv-listen-child () (in *Pipe_child - (when (rd) (kv-out-client "message" (cdr @) ] + (when (rd) (out *Sock (pr @) ] # pipe the message as-is to the client # Send a message to the sibling over a named pipe [de kv-out-sibling (Type . @) @@ -423,14 +565,14 @@ [de kv-hash (String) (hash String) ] -# Authenticate the client via handshake, and authorizate with a hashed password +# Authenticate the client via handshake, and authorize with a hashed password [de kv-auth (Auth) (and (lst? Auth) (= "AUTH" (car Auth)) (= (kv-hash *KV_pass) (caddr Auth)) - (kv-out-client "AUTH" (kv-hash (pack (cadr Auth) *KV_uuid))) - (kv-out-sibling "message" (list "IDENT" (cons "name" (cadr Auth)) (cons "addr" *Adr) (cons "fd" *Sock))) + (kv-out-client "auth" (kv-hash (pack (cadr Auth) *KV_uuid))) + (kv-out-sibling "message" (list "IDENT" (cons "name" (cadr Auth)) (cons "addr" *Adr) (cons "port" *SPort) (cons "fd" *Sock))) (kv-listen-child) ] # Receive the initial auth in a child process from the client over a TCP socket @@ -481,15 +623,14 @@ # Process the message depending on its type [de kv-sibling-message (Type Pid Msg) (case Type - ("error" (kv-sibling-error Pid Msg)) - ("done" (kv-remove-client Pid)) - ("message" (kv-sibling-job Pid Msg) ] + ("error" (kv-sibling-error Pid Msg)) + ("done" (kv-remove-client Pid)) + ("message" (kv-sibling-job Pid Msg) ] # Increment some statistics counters for the INFO command -[de kv-stats-update (Pid Msg) +[de kv-stats-update (Msg) (inc '*KV/%stats%/total_commands_processed) - (inc '*KV/%stats%/total_net_input_bytes (bytes Msg)) - (push1 '*KV/%stats%/total_connections_received Pid) ] + (inc '*KV/%stats%/total_net_input_bytes (bytes Msg) ] # Receive a message in the sibling, from the child, over a named pipe, then # process the message and send the reply back to the child @@ -497,7 +638,7 @@ [in *Pipe_sibling (when (rd) (let Msg @ - (kv-stats-update (cadr Msg) (caddr Msg)) + (kv-stats-update (caddr Msg)) (kv-sibling-message (car Msg) # should be the 'type' of message (cadr Msg) # should be the sender's Pid diff --git a/libkvclient.l b/libkvclient.l index 81accf0..5dbc24b 100644 --- a/libkvclient.l +++ b/libkvclient.l @@ -14,14 +14,15 @@ *KV_port 6378 *KV_pass NIL *KV_abort 60 # max time (in seconds) to wait for a message - *KV_uuid "7672FDB2-4D29-4F10-BA7C-8EAD0E29626E" ) # for server handshake, do not change + *KV_uuid "7672FDB2-4D29-4F10-BA7C-8EAD0E29626E" # for server handshake, do not change + *KV_gpgid "secrets/gpg-id" ) # key name containing the GPG ID used to encrypt data (off *KV_poll) # HELPERS # Send error message to STDERR [de kv-throw (Error) - (msg Error) + (out 2 (prinl Error)) (setq *Msg Error) (throw 'kv-error Error) ] @@ -31,39 +32,58 @@ ((lst? Result) (prinl (glue "," Result))) (T (prinl Result) ] -# non cryptographically secure hash, can be changed in the future +# Non cryptographically secure hash, can be changed in the future [de kv-hash (String) (hash String) ] +# Encrypt a string from STDIN using GPG, with one recipient +[de kv-encrypt-gpg (String Id) + (pipe + (out (list 'gpg "-v" "--output" "-" "--yes" "-a" "--encrypt" "-r" Id) + (prin String) ) + (till NIL T) ] + +# Decrypt a string using GPG +[de kv-decrypt-gpg (String) + (pipe + (out (list 'gpg "-q" "--decrypt" "--yes") + (prin String) ) + (till NIL T) ] + +[de kv-encrypt-getid (Args) + (case (length Args) + (3 (member (car Args) '("APPEND" "GETSET" "LPUSH" "MSET" "RPUSH" "SET"))) + (4 (member (car Args) '("HSET" "LSET"))) ) + (and + @ + (kv-send-commands (list "GET" (list *KV_gpgid))) + (kv-receive) ] + +[de kv-encrypt (Args) + (if (and + (cdr (kv-encrypt-getid Args)) + (kv-send-commands (place (length Args) Args (kv-encrypt-gpg (last Args) @))) ) + (kv-receive-data) + "unable to send encrypted data" ] + # IPC # Send commands to the server on the TCP socket [de kv-send-commands (Cmdargs) - (case (uppc (pop 'Cmdargs)) - ["BGSAVE" (out *Sock (pr (list "BGSAVE") ] - ["CLIENT" (out *Sock (pr (list "CLIENT" (pop 'Cmdargs) (pop 'Cmdargs) (format (pop 'Cmdargs) ] - ["CONVERT" (out *Sock (pr (list "CONVERT") ] - ["DEL" (out *Sock (pr (list "DEL" (pop 'Cmdargs) Cmdargs) ] - ["EXISTS" (out *Sock (pr (list "EXISTS" (pop 'Cmdargs) Cmdargs) ] - ["GET" (out *Sock (pr (list "GET" (pop 'Cmdargs) ] - ["GETSET" (out *Sock (pr (list "GETSET" (pop 'Cmdargs) (pop 'Cmdargs) ] - ["INFO" (out *Sock (pr (list "INFO" (pop 'Cmdargs) ] - ["LINDEX" (out *Sock (pr (list "LINDEX" (pop 'Cmdargs) (format (pop 'Cmdargs) ] - ["LLEN" (out *Sock (pr (list "LLEN" (pop 'Cmdargs) ] - ["LPOP" (out *Sock (pr (list "LPOP" (pop 'Cmdargs) ] - ["LPOPRPUSH" (out *Sock (pr (list "LPOPRPUSH" (pop 'Cmdargs) (pop 'Cmdargs) ] - ["PING" (out *Sock (pr (list "PING" (pop 'Cmdargs) ] - ["RPUSH" (out *Sock (pr (list "RPUSH" (pop 'Cmdargs) Cmdargs) ] - ["SAVE" (out *Sock (pr (list "SAVE") ] - ["SET" (out *Sock (pr (list "SET" (pop 'Cmdargs) (pop 'Cmdargs) ] - (T (setq *Bye '((msg "ERROR: unknown command"))) (bye 1) ] + (out *Sock (pr (list (uppc (pop 'Cmdargs)) Cmdargs) ] # Send commands to the server and receive a response [de kv-send-data (Cmdargs) - (when (kv-send-commands Cmdargs) (kv-receive-data) ] + (if *KV_encrypt + (kv-encrypt Cmdargs) + (if (kv-send-commands Cmdargs) + (if *KV_decrypt + (kv-decrypt-gpg (kv-receive-data)) + (kv-receive-data) ) + "unable to send data" ] # Receive data from the server on the TCP socket, return the result or NIL [de kv-receive () - (in *Sock (when (rd) @) ] + (abort *KV_abort (in *Sock (when (rd) @) ] # Receive data from the server on the TCP socket, return the parsed result [de kv-receive-data () @@ -71,19 +91,18 @@ (in *Sock (when (rd) (let Result @ - (if (cdr Result) - (case (car Result) - ("message" (cdr Result)) # good response from the server - (T "unknown data")) # bad response from the server - "no data" ) ] # NIL response from the server + (and (car Result) (= "message" @) (cdr Result) ] # Authenticate to the server by hashing the password and validating the response [de kv-authenticate () (out *Sock (pr (list "AUTH" *KV_clientid (kv-hash *KV_pass)))) - (in *Sock - (if (and (rd) (= (cdr @) (kv-hash (pack *KV_clientid *KV_uuid)))) - (kv-receive-data) - (kv-throw "ERROR: bad auth") ] + (let Auth (kv-receive) + (case (car Auth) + ("auth" (if (= (cdr Auth) (kv-hash (pack *KV_clientid *KV_uuid))) + (kv-receive-data) + (kv-throw "ERROR: bad auth") ) ) + ("error" (kv-throw (pack "ERROR: " (cdr Auth)))) + (T (kv-throw "ERROR: unknown response from server") ] # Open a TCP socket and connect to the server [de kv-start-client () diff --git a/module.l b/module.l index 7bbf789..3e1f633 100644 --- a/module.l +++ b/module.l @@ -1,6 +1,6 @@ [de APP_INFO ("name" "picolisp-kv") - ("version" "0.15.1") + ("version" "0.16.0") ("summary" "Redis-inspired in-memory key/value store written in PicoLisp") ("source" "https://github.com/aw/picolisp-kv") ("author" "Alexander Williams") diff --git a/test.l b/test.l index c6e9817..55c3cef 100755 --- a/test.l +++ b/test.l @@ -24,12 +24,14 @@ (setq *KV_port (rand 40001 49999)) # run the client/server tests without persistence +#{ # NOTE: disabled integration tests (chdir (pack (car (file)) "test/") - (call 'rm "-f" *KV_db (pack "." *KV_db ".old") *KV_aof *KV_aof_lock) # cleanup first + (call 'rm "-f" *KV_db (pack *KV_db ".old") *KV_aof *KV_aof_lock) # cleanup first (unless (fork) (exec '../server.l "--pass" *KV_pass "--port" *KV_port) ) (mapcar load (filter '((N) (sub? "test_cs" N)) (dir "."))) ) (kill (car (kids))) # ensure the server is stopped +}# (report) diff --git a/test/test_cs.l b/test/test_cs.l index 244a906..d578141 100644 --- a/test/test_cs.l +++ b/test/test_cs.l @@ -5,15 +5,15 @@ [de tests-execute () (call './client.l "--port" *KV_port "--name" *Client_id "--pass" *KV_pass "INFO") - (assert-equal (pack "OK " *Client_id) (in (test-client-cmd "INFO" "server") (line T)) "[CLIENT/SERVER] Test INFO command") - (assert-equal "OK" (in (test-client-cmd "SET" "testkey" "testdata") (line) (line T)) "[CLIENT/SERVER] Test SET command") - (assert-equal "testdata" (in (test-client-cmd "GET" "testkey") (line) (line T)) "[CLIENT/SERVER] Test GET command") - (assert-equal "no data" (in (test-client-cmd "GET" "nokey") (line) (line T)) "[CLIENT/SERVER] Test NO DATA result") - (assert-nil (call './client.l "--port" *KV_port "--name" *Client_id "--pass" *KV_pass "UNKNOWN") "[CLIENT/SERVER] Test UNKNOWN command") - (assert-nil (call './client.l "--port" *KV_port "--name" *Client_id "--pass" "badpass" "GET") "[CLIENT/SERVER] Test AUTH with bad password") - (assert-kind-of 'Number (in (test-client-cmd "GET" "%stats%/keyspace_hits") (line) (format (line T))) "[CLIENT/SERVER] Test STATS command") - (assert-includes (pack "name=" *Client_id " addr=") (in (test-client-cmd "CLIENT" "LIST") (line) (line T)) "[CLIENT/SERVER] Test CLIENT LIST command") - (assert-kind-of 'Number (in (test-client-cmd "CLIENT" "ID") (line) (format (line T))) "[CLIENT/SERVER] Test CLIENT ID command") + (assert-equal "# Server" (in (test-client-cmd "INFO" "server") (line) (line T)) "[CLIENT/SERVER] Test INFO command") + (assert-equal "OK" (in (test-client-cmd "SET" "testkey" "testdata") (line T)) "[CLIENT/SERVER] Test SET command") + (assert-equal "testdata" (in (test-client-cmd "GET" "testkey") (line T)) "[CLIENT/SERVER] Test GET command") + (assert-nil (in (test-client-cmd "GET" "nokey") (line T)) "[CLIENT/SERVER] Test NO DATA result") + (assert-t (call './client.l "--port" *KV_port "--name" *Client_id "--pass" *KV_pass "UNKNOWN") "[CLIENT/SERVER] Test UNKNOWN command") + (assert-nil (call './client.l "--port" *KV_port "--name" *Client_id "--pass" "badpass" "GET") "[CLIENT/SERVER] Test AUTH with bad password") + (assert-kind-of 'Number (in (test-client-cmd "GET" "%stats%/keyspace_hits") (format (line T))) "[CLIENT/SERVER] Test STATS command") + (assert-includes (pack "name=" *Client_id " addr") (in (test-client-cmd "CLIENT" "LIST") (line T)) "[CLIENT/SERVER] Test CLIENT LIST command") + (assert-kind-of 'Number (in (test-client-cmd "CLIENT" "ID") (format (line T))) "[CLIENT/SERVER] Test CLIENT ID command") ] [de tests-client-server () diff --git a/test/test_kv.l b/test/test_kv.l index 9f85b1e..54bc76d 100644 --- a/test/test_kv.l +++ b/test/test_kv.l @@ -1,5 +1,23 @@ # Key/Value tests +[de test-commands-append () + (kv-cmd-rpush "appendlist" '("one" "two")) + (assert-nil (kv-cmd-append) "[APPEND] Should return NIL if no key is provided") + (assert-nil (kv-cmd-append "testkey") "[APPEND] Should return NIL if no value is provided") + (assert-nil (kv-cmd-append "appendlist" "test") "[APPEND] Should return NIL if the key is not a string") + (kv-cmd-set "appendkey" "hello") + (assert-equal 10 (kv-cmd-append "appendkey" "world") "[APPEND] Should append a key and return its length") + (assert-equal "helloworld" (kv-cmd-get "appendkey") "[GET] Should return the value of the key") + ] + +[de test-commands-client () + (kv-cmd-ident 12345 (list (cons "name" "abc"))) + (assert-kind-of 'Number (kv-cmd-client 12345 '("ID")) "[CLIENT LIST] Should return a client id") + (assert-kind-of 'String (kv-cmd-client NIL '("LIST")) "[CLIENT LIST] Should return a client list") + (assert-equal 1 (kv-cmd-client NIL '("KILL" "ID" "1")) "[CLIENT LIST] Should kill a client") + (assert-equal 0 (kv-cmd-client NIL '("KILL" "ID" "2")) "[CLIENT LIST] Should not kill a client that doesn't exist") + ] + [de test-commands-get-set () (assert-nil (kv-cmd-set) "[SET] Should return NIL if no key is provided") (assert-nil (kv-cmd-set "testkey") "[SET] Should return NIL if no value is provided") @@ -9,30 +27,15 @@ (assert-equal "testvalue" (kv-cmd-get "testkey") "[GET] Should return the value of the key") (assert-equal "testvalue" (kv-cmd-getset "testkey" "newvalue") "[GETSET] Should return the old value") (assert-equal "newvalue" (kv-cmd-get "testkey") "[GETSET] Should return the new value") - ] - -[de test-commands-rpush () - (assert-nil (kv-cmd-rpush) "[RPUSH] Should return NIL if no key is provided") - (assert-nil (kv-cmd-rpush "tasks") "[RPUSH] Should return NIL if only 1 key is provided") - (assert-nil (kv-cmd-rpush "tasks" (kv-name "tasks")) "[RPUSH] Should return NIL if no elements are provided") - (assert-nil (kv-cmd-rpush "tasks" (kv-name "tasks") "element 1") "[RPUSH] Should return NIL if the elements aren't a list") - (off *KV/%stats%/keys) - (assert-equal 5 (kv-cmd-rpush "tasks" (kv-name "tasks") '("task1" "task2" "task3" "task4" "task5")) "[RPUSH] Should return the length of the new list") - (assert-equal 7 (kv-cmd-rpush "tasks" (kv-name "tasks") '("task6" "task7")) "[RPUSH] Should return the extended length of the list") - (assert-equal "task1" (kv-cmd-lindex (kv-name "tasks") 0) "[LINDEX] Should return the key at index 0") - (assert-equal "task5" (kv-cmd-lindex (kv-name "tasks") 4) "[LINDEX] Should return the key at index 5") - (assert-equal "task7" (kv-cmd-lindex (kv-name "tasks") -1) "[LINDEX] Should return the last key") - (assert-equal "task6" (kv-cmd-lindex (kv-name "tasks") -2) "[LINDEX] Should return the penultimate key") - (assert-nil (kv-cmd-lindex (kv-name "tasks") 10) "[LINDEX] Should return NIL if no value exists at the index") - (assert-equal 1 (kv-cmd-llen (kv-name "%stats%/keys")) "[LLEN] Should return the number of keys in the keys list") - (assert-equal "tasks" (kv-cmd-lindex (kv-name "%stats%/keys") 0) "[LINDEX] Should return the name of the key in the keys list") - (assert-equal "task1" (kv-cmd-lpop (kv-name "tasks")) "[LPOP] Should return the first value added to the tasks list") - (assert-equal 6 (kv-cmd-llen (kv-name "tasks")) "[LLEN] Should return the number of keys remaining in the tasks list") + (assert-nil (kv-cmd-mset "key1" "val1" "key2" "val2") "[MSET] Should return NIL if key/values aren't in a list") + (assert-equal "OK" (kv-cmd-mset '("key1" "val1" "key2" "val2")) "[MSET] Should set multiple keys and values and return OK") + (assert-nil (kv-cmd-mget "key1" "key2") "[MGET] Should return NIL if key aren't in a list") + (assert-equal '("val1" "val2") (kv-cmd-mget '("key1" "key2")) "[MGET] Should return multiple values in a list") ] [de test-commands-stats-failures () (assert-nil (kv-cmd-set "%stats%/connected_clients" 0) "[SET] Should fail to overwrite a stats key") - (assert-nil (kv-cmd-rpush "%stats%/connected_clients" (kv-name "%stats%/connected_clients") '(1 2 3)) "[RPUSH] Should fail to rpush to a stats key") + (assert-nil (kv-cmd-rpush "%stats%/connected_clients" '(1 2 3)) "[RPUSH] Should fail to rpush to a stats key") (assert-nil (kv-cmd-lpop (kv-name "%stats%/connected_clients")) "[LPOP] Should fail to left-pop a stats key") (assert-nil (kv-cmd-lpoprpush (kv-name "%stats%/connected_clients") "destkey") "[LPOPRPUSH] Should fail to left-pop a stats key") (assert-nil (kv-cmd-lpoprpush (kv-name "sourcekey") "%stats%/connected_clients") "[LPOPRPUSH] Should fail to rpush to a stats key") @@ -40,84 +43,50 @@ (assert-equal 1 (kv-cmd-del "validkey" (list "%stats%/connected_clients")) "[DEL] Should fail to delete multiple stats key") ] -[de test-commands-lindex () - (assert-nil (kv-cmd-lindex) "[LINDEX] Should return NIL if no key is provided") - (assert-nil (kv-cmd-lindex (kv-name "testindex")) "[LINDEX] Should return NIL if no index is provided") - (assert-nil (kv-cmd-lindex (kv-name "nonexistant")) "[LINDEX] Should return NIL if the key doesn't exist") - (assert-nil (kv-cmd-lindex (kv-name "testindex") "abc") "[LINDEX] Should return NIL if index isn't a number") - ] - [de test-commands-ident () (assert-nil (kv-cmd-ident) "[IDENT] Should return NIL if no child pid is provided") (assert-nil (kv-cmd-ident 12345) "[IDENT] Should return NIL if no elements are provided") (assert-nil (kv-cmd-ident 12345 "abc") "[IDENT] Should return NIL if elements aren't a list") (assert-equal "OK abc" (kv-cmd-ident 12345 (list (cons "name" "abc"))) "[IDENT] Should return OK with the client ID") - (assert-equal '12345 (cdr (assoc "pid" (cadr (kv-cmd-lindex (kv-name "%stats%/connected_clients") 0)))) "[LINDEX] Should return the info of the connected client") - (assert-kind-of 'Number (kv-cmd-llen (kv-name "%stats%/connected_clients")) "[LLEN] Should show only 1 connected client") + (assert-kind-of 'Number (kv-cmd-strlen "%stats%/connected_clients") "[LLEN] Should show only 1 connected client") ] [de test-commands-info () (assert-equal *KV_port (cdr (assoc "tcp_port" (kv-info-server))) "[INFO-SERVER] Should return a list of server INFO") (assert-nil (cdr (assoc "connected_clients" (kv-info-server))) "[INFO-CLIENTS] Should return a list of clients INFO") (assert-kind-of 'String (cdr (assoc "used_memory_human" (kv-info-memory))) "[INFO-MEMORY] Should return a list of memory INFO") - (assert-equal 1 (cdr (assoc "total_connections_received" (kv-info-stats))) "[INFO-STATS] Should return a list of stats INFO") + (assert-kind-of 'Number (cdr (assoc "total_connections_received" (kv-info-stats))) "[INFO-STATS] Should return a list of stats INFO") (assert-kind-of 'String (kv-info-default) "[INFO] Should return a string of INFO") ] -[de test-commands-lpop () - (assert-nil (kv-cmd-lpop) "[LPOP] Should return NIL if no key is provided") - (assert-nil (kv-cmd-lpop (kv-name "nonexistant")) "[LPOP] Should return NIL if the key doesn't exist") - ] - -[de test-commands-lpoprpush () - (assert-nil (kv-cmd-lpoprpush) "[LPOPRPUSH] Should return NIL if no source is provided") - (assert-nil (kv-cmd-lpoprpush (kv-name "inkey")) "[LPOPRPUSH] Should return NIL if no dest is provided") - (assert-nil (kv-cmd-lpoprpush (kv-name "nonexistant")) "[LPOPRPUSH] Should return NIL if the key doesn't exist") - (kv-cmd-rpush "inkey" (kv-name "inkey") '(5 6 7 8 9)) - (assert-equal 5 (kv-cmd-lpoprpush (kv-name "inkey") "outkey") "[LPOPRPUSH] Should return the element being popped") - (assert-equal 4 (kv-cmd-llen (kv-name "inkey")) "[LLEN] Should list only 4 elements in the source key") - (assert-equal 1 (kv-cmd-llen (kv-name "outkey")) "[LLEN] Should list only 1 element in the dest key") - (assert-equal 5 (kv-cmd-lindex (kv-name "outkey") 0) "[LINDEX] Should return the value of the popped key") - (assert-equal 6 (kv-cmd-lindex (kv-name "inkey") 0) "[LINDEX] Should return the value of the first key") - (assert-equal 6 (kv-cmd-lpoprpush (kv-name "inkey") "outkey") "[LPOPRPUSH] Should return the element being popped (again)") - ] - [de test-commands-del () (kv-cmd-set "delkey1" "deletekey") (assert-equal 1 (kv-cmd-del "delkey1") "[DEL] Should delete a single key") - (kv-cmd-rpush "delkey2" (kv-name "delkey2") '(0 0 1 1 0 1 0 0)) - (kv-cmd-rpush "delkey3" (kv-name "delkey3") '(0 0 1 1 0 1 1 0)) + (kv-cmd-rpush "delkey2" '(0 0 1 1 0 1 0 0)) + (kv-cmd-rpush "delkey3" '(0 0 1 1 0 1 1 0)) (assert-equal 4 (kv-cmd-del "delkey2" (list "delkey3" "delkey4" "delkey5")) "[DEL] Should delete multiple keys and return how many were deleted") - (assert-equal 0 (kv-cmd-llen (kv-name "delkey2")) "[LLEN] Should confirm if delkey2 was deleted") - (assert-equal 0 (kv-cmd-llen (kv-name "delkey3")) "[LLEN] Should confirm if delkey3 was deleted") + (assert-equal 0 (kv-cmd-strlen "delkey2") "[LLEN] Should confirm if delkey2 was deleted") + (assert-equal 0 (kv-cmd-strlen "delkey3") "[LLEN] Should confirm if delkey3 was deleted") (assert-equal 0 (kv-cmd-del) "[DEL] Should not delete a key that isn't provided") ] [de test-commands-process () (assert-equal "Error: Unknown command" (kv-process 12345 (list "UNKNOWN")) "[PROCESS] Should return an ERROR message if the command is unknown") - (assert-equal 1 (kv-process 12345 (list "DEL" "processkey")) "[PROCESS] Should process the DEL command") - (assert-equal "OK" (kv-process 12345 (list "SET" "processkey" "processvalue")) "[PROCESS] Should process the SET command") - (assert-equal "processvalue" (kv-process 12345 (list "GET" "processkey")) "[PROCESS] Should process the GET command") - (assert-equal 3 (kv-process 12345 (list "RPUSH" "processkey" (11 22 33))) "[PROCESS] Should process the RPUSH command") - (assert-equal "OK 007" (kv-process 12345 (list "IDENT" (list "name" "007"))) "[PROCESS] Should process the IDENT command") - (assert-kind-of 'String (kv-process 12345 (list "INFO")) "[PROCESS] Should process the INFO command") - (assert-equal 22 (kv-process 12345 (list "LINDEX" "processkey" 1)) "[PROCESS] Should process the LINDEX command") - (assert-equal 3 (kv-process 12345 (list "LLEN" "processkey")) "[PROCESS] Should process the LLEN command") - (assert-equal 11 (kv-process 12345 (list "LPOP" "processkey")) "[PROCESS] Should process the LPOP command") - (assert-equal 22 (kv-process 12345 (list "LPOPRPUSH" "processkey" "processdest")) "[PROCESS] Should process the LPOPRPUSH command") - (assert-kind-of 'String (kv-process 12345 (list "info" "server")) "[PROCESS] Should process a lowercase command") + (assert-equal "OK" (kv-process 12345 (list "SET" '("processkey2" "processvalue"))) "[PROCESS] Should process the SET command") + (assert-equal 3 (kv-process 12345 (list "RPUSH" '("processkeytest" 11 22 33))) "[PROCESS] Should process the RPUSH command") + (assert-equal 3 (kv-process 12345 (list "LLEN" '("processkeytest"))) "[PROCESS] Should process the LLEN command") + (assert-kind-of 'String (kv-process 12345 (list "info" '("server"))) "[PROCESS] Should process a lowercase command") ] [de test-commands-bgsave () - (kv-cmd-rpush "mylist" (kv-name "mylist") '("1" "2" "3" "4" "5" "6" "7" "8" "9" "10")) + (kv-cmd-rpush "mylist" '("1" "2" "3" "4" "5" "6" "7" "8" "9" "10")) (let KV_desc (open *KV_aof) - (kv-save-aof '("RPUSH" "mylist" ("1" "2" "3" "4" "5" "6" "7" "8" "9" "10")) KV_desc) + (kv-save-aof '("RPUSH" '("mylist" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10")) KV_desc) (close KV_desc) ) (assert-equal "OK" (kv-cmd-get "%stats%/aof_last_write_status") "[BGSAVE] Should be OK for saving a valid AOF entry") (kv-save-db-keys) (kv-write-db) (assert-equal 0 (kv-restore "DB" *KV_db) "[BGSAVE] Should return 0 when restoring the DB") - (assert-equal 0 (kv-restore "AOF" *KV_aof) "[BGSAVE] Should return 0 when restoring the AOF") (out *KV_db_lock (prinl "12345")) (assert-equal "Error: DB is locked for writing" (kv-locked?) "[BGSAVE] Should return an error if the DB is locked") (call 'rm "-f" *KV_db_lock) @@ -130,8 +99,8 @@ ] [de test-commands-exists () - (kv-cmd-rpush "existlist" (kv-name "existlist") '("1" "2" "3" "4" "5" "6" "7" "8" "9" "10")) - (kv-cmd-rpush "existlist2" (kv-name "existlist2") '("1" "2" "3" "4" "5" "6" "7" "8" "9" "10")) + (kv-cmd-rpush "existlist" '("1" "2" "3" "4" "5" "6" "7" "8" "9" "10")) + (kv-cmd-rpush "existlist2" '("1" "2" "3" "4" "5" "6" "7" "8" "9" "10")) (assert-equal 1 (kv-cmd-exists "existlist") "[EXISTS] Should return 1 if the key exists") (assert-equal 0 (kv-cmd-exists "nonexists") "[EXISTS] Should return 0 if the key doesn't exist") (assert-equal 2 (kv-cmd-exists "existlist" '("existlist2")) "[EXISTS] Should return 2 if the two keys exist") @@ -142,21 +111,28 @@ (assert-equal "PONG" (kv-cmd-ping) "[PING] Should return PONG") (assert-equal "Hello" (kv-cmd-ping "Hello") "[PING] Should return Hello") ] + +[de test-commands-strlen () + (kv-cmd-set "lengthkey" "hello") + (assert-nil (kv-cmd-strlen) "[STRLEN] Should return NIL if the key isn't provided") + (assert-equal 0 (kv-cmd-strlen "nonexists") "[STRLEN] Should return 0 if the key doesn't exist") + (assert-equal 5 (kv-cmd-strlen "lengthkey") "[STRLEN] Should return the length of the key's value") + ] + [execute (prinl "^J Testing Key/Value^J") - '(assert-equal 0 (kv-cmd-llen (kv-name "nonexistant")) "[LLEN] Should return 0 if the key doesn't exist") + '(assert-equal 0 (kv-cmd-strlen "nonexistant") "[LLEN] Should return 0 if the key doesn't exist") + '(test-commands-append) + '(test-commands-client) '(test-commands-del) '(test-commands-get-set) '(test-commands-ident) '(test-commands-info) - '(test-commands-lindex) - '(test-commands-lpop) - '(test-commands-lpoprpush) - '(test-commands-rpush) '(test-commands-stats-failures) '(test-commands-process) '(test-commands-bgsave) '(test-commands-exists) '(test-commands-ping) + '(test-commands-strlen) ] diff --git a/test/test_kv_hashes.l b/test/test_kv_hashes.l new file mode 100644 index 0000000..399401f --- /dev/null +++ b/test/test_kv_hashes.l @@ -0,0 +1,114 @@ +# Key/Value Hashes tests + +[de test-commands-hdel () + (kv-cmd-hset "hashdelkey" '("one" "1" "two" "2")) + (kv-cmd-set "hashkeyz" "string") + (assert-nil (kv-cmd-hdel) "[HDEL] Should return NIL if no key is provided") + (assert-nil (kv-cmd-hdel "hashdelkey") "[HDEL] Should return NIL if no field is provided") + (assert-nil (kv-cmd-hdel "hashkeyz") "[HDEL] Should return NIL if the key isn't a list") + (assert-nil (kv-cmd-hdel "hashkeyzmissing") "[HDEL] Should return NIL if the key doesn't exist") + (assert-nil (kv-cmd-hdel "hashdelkey" "one") "[HDEL] Should return NIL if the fields are not a list") + (assert-equal 1 (kv-cmd-hdel "hashdelkey" '("one")) "[HDEL] Should return 1 if the field is deleted") + (assert-equal 0 (kv-cmd-hdel "hashdelkey" '("three")) "[HDEL] Should return 0 if the field is not deleted") + ] + +[de test-commands-hexists () + (kv-cmd-hset "hashexistskey" '("one" "1" "two" "2")) + (kv-cmd-set "hashkeyz" "string") + (assert-equal 0 (kv-cmd-hexists) "[HEXISTS] Should return 0 if no key is provided") + (assert-equal 0 (kv-cmd-hexists "hashexistskey") "[HEXISTS] Should return 0 if no field is provided") + (assert-nil (kv-cmd-hget "hashkeyz") "[HEXISTS] Should return NIL if key is not a list") + (assert-equal 0 (kv-cmd-hexists "hashkeyzmissing") "[HEXISTS] Should return 0 if the key doesn't exist") + (assert-equal 0 (kv-cmd-hexists "hashexistskey" "three") "[HEXISTS] Should return 0 if the field doesn't exist") + (assert-equal 1 (kv-cmd-hexists "hashexistskey" "one") "[HEXISTS] Should return 1 if the key and field exists") + ] + +[de test-commands-hget () + (kv-cmd-hset "hashgetkey" '("one" "1" "two" "2")) + (kv-cmd-set "hashkeyz" "string") + (assert-nil (kv-cmd-hget) "[HGET] Should return NIL if no key is provided") + (assert-nil (kv-cmd-hget "hashgetkey") "[HGET] Should return NIL if no field is provided") + (assert-nil (kv-cmd-hget "hashkeyz") "[HGET] Should return NIL if key is not a list") + (assert-nil (kv-cmd-hget "hashkeyzmissing") "[HGET] Should return NIL if the key doesn't exist") + (assert-equal "1" (kv-cmd-hget "hashgetkey" "one") "[HGET] Should return 1 if the field has a value") + (assert-equal NIL (kv-cmd-hget "hashgetkey" "three") "[HGET] Should return NIL if the field has no value") + ] + +[de test-commands-hgetall () + (kv-cmd-hset "hashgetallkey" '("one" "1" "two" "2")) + (kv-cmd-set "hashkeyz" "string") + (assert-nil (kv-cmd-hgetall) "[HGETALL] Should return NIL if no key is provided") + (assert-nil (kv-cmd-hgetall "hashkeyz") "[HGETALL] Should return NIL if the key is not a list") + (assert-nil (kv-cmd-hgetall "hashkeyzmissing") "[HGETALL] Should return NIL if the key doesn't exist") + (assert-equal '(("one" . "1") ("two" . "2")) (kv-cmd-hgetall "hashgetallkey") "[HGETALL] Should return all fields and values") + ] + +[de test-commands-hkeys () + (kv-cmd-hset "hashkeyskey" '("one" "1" "two" "2")) + (kv-cmd-set "hashkeyz" "string") + (assert-nil (kv-cmd-hkeys) "[HKEYS] Should return NIL if no key is provided") + (assert-nil (kv-cmd-hkeys "hashkeyz") "[HKEYS] Should return NIL if the key is not a list") + (assert-nil (kv-cmd-hkeys "hashkeyzmissing") "[HKEYS] Should return NIL if the key doesn't exist") + (assert-equal '("one" "two") (kv-cmd-hkeys "hashkeyskey") "[HKEYS] Should return all fields") + ] + +[de test-commands-hlen () + (kv-cmd-hset "hashlenkey" '("one" "1" "two" "2")) + (kv-cmd-set "hashkeyz" "string") + (assert-nil (kv-cmd-hlen) "[HLEN] Should return NIL if no key is provided") + (assert-nil (kv-cmd-hlen "hashkeyz") "[HLEN] Should return NIL if the key is not a list") + (assert-equal 0 (kv-cmd-hlen "hashkeyzmissing") "[HLEN] Should return 0 if the key doesn't exist") + (assert-equal 2 (kv-cmd-hlen "hashlenkey") "[HLEN] Should return all fields") + ] + +[de test-commands-hmget () + (kv-cmd-hset "hashmgetkey" '("one" "1" "two" "2")) + (kv-cmd-set "hashkeyz" "string") + (assert-nil (kv-cmd-hmget) "[HMGET] Should return NIL if no key is provided") + (assert-nil (kv-cmd-hmget "hashmgetkey") "[HMGET] Should return NIL if no field is provided") + (assert-nil (kv-cmd-hmget "hashkeyz") "[HMGET] Should return NIL if key is not a list") + (assert-nil (kv-cmd-hmget "hashkeyzmissing") "[HMGET] Should return NIL if the key doesn't exist") + (assert-equal '("1" "2") (kv-cmd-hmget "hashmgetkey" '("one" "two")) "[HMGET] Should return a list if the field has a value") + (assert-equal '(NIL) (kv-cmd-hmget "hashmgetkey" '("three")) "[HMGET] Should return an empty list if the field has no value") + ] + +[de test-commands-hset () + (kv-cmd-set "hashkeyz" "string") + (assert-nil (kv-cmd-hset) "[HSET] Should return NIL if no key is provided") + (assert-nil (kv-cmd-hset "hashkeyz" '("one" 1)) "[HSET] Should return NIL if the key is not a list") + (assert-nil (kv-cmd-hset "hashkeyz" "one" "two") "[HSET] Should return NIL if the fields is not a list") + (assert-nil (kv-cmd-hset "hashkeyzmissing") "[HSET] Should return NIL if the key doesn't exist") + (assert-equal 2 (kv-cmd-hset "hashsetkey" '("one" "1" "two" "2")) "[HSET] Should return the number of fields added") + ] + +[de test-commands-hstrlen () + (kv-cmd-hset "hashstrlenkey" '("one" "hello" "two" "world")) + (kv-cmd-set "hashkeyz" "string") + (assert-nil (kv-cmd-hstrlen) "[HSTRLEN] Should return NIL if no key is provided") + (assert-nil (kv-cmd-hstrlen "hashkeyz") "[HSTRLEN] Should return NIL if the key is not a list") + (assert-equal 0 (kv-cmd-hstrlen "hashstrlenkey") "[HSTRLEN] Should return 0 if the field is not provided") + (assert-equal 0 (kv-cmd-hstrlen "hashkeyzmissing") "[HSTRLEN] Should return 0 if the key doesn't exist") + (assert-equal 5 (kv-cmd-hstrlen "hashstrlenkey" "one") "[HSTRLEN] Should return the length of the string") + ] + +[de test-commands-hvals () + (kv-cmd-hset "hashvalskey" '("one" "1" "two" "2")) + (kv-cmd-set "hashkeyz" "string") + (assert-nil (kv-cmd-hvals) "[HVALS] Should return NIL if no key is provided") + (assert-nil (kv-cmd-hvals "hashkeyz") "[HVALS] Should return NIL if the key is not a list") + (assert-nil (kv-cmd-hvals "hashkeyzmissing") "[HVALS] Should return NIL if the key doesn't exist") + (assert-equal '("1" "2") (kv-cmd-hvals "hashvalskey") "[HVALS] Should return all values") + ] + +[execute + '(test-commands-hdel) + '(test-commands-hexists) + '(test-commands-hget) + '(test-commands-hgetall) + '(test-commands-hkeys) + '(test-commands-hlen) + '(test-commands-hmget) + '(test-commands-hset) + '(test-commands-hstrlen) + '(test-commands-hvals) + ] diff --git a/test/test_kv_lists.l b/test/test_kv_lists.l new file mode 100644 index 0000000..f770fc9 --- /dev/null +++ b/test/test_kv_lists.l @@ -0,0 +1,132 @@ +# Key/Value Lists tests + +[de test-commands-lindex () + (assert-nil (kv-cmd-lindex) "[LINDEX] Should return NIL if no key is provided") + (assert-nil (kv-cmd-lindex "testindex") "[LINDEX] Should return NIL if no index is provided") + (assert-nil (kv-cmd-lindex "nonexistant") "[LINDEX] Should return NIL if the key doesn't exist") + (assert-nil (kv-cmd-lindex "testindex" "abc") "[LINDEX] Should return NIL if index isn't a number") + ] + +[de test-commands-lpop () + (assert-nil (kv-cmd-lpop) "[LPOP] Should return NIL if no key is provided") + (assert-nil (kv-cmd-lpop "nonexistant") "[LPOP] Should return NIL if the key doesn't exist") + ] + +[de test-commands-lpoprpush () + (off *KV/inkey) + (off *KV/outkey) + (assert-nil (kv-cmd-lpoprpush) "[LPOPRPUSH] Should return NIL if no source is provided") + (assert-nil (kv-cmd-lpoprpush "inkey") "[LPOPRPUSH] Should return NIL if no dest is provided") + (assert-nil (kv-cmd-lpoprpush "nonexistant") "[LPOPRPUSH] Should return NIL if the key doesn't exist") + (kv-cmd-rpush "inkey" '(5 6 7 8 9)) + (assert-equal 5 (kv-cmd-lpoprpush "inkey" "outkey") "[LPOPRPUSH] Should return the element being popped") + (assert-equal 4 (kv-cmd-strlen "inkey") "[LLEN] Should list only 4 elements in the source key") + (assert-equal 1 (kv-cmd-strlen "outkey") "[LLEN] Should list only 1 element in the dest key") + (assert-equal 5 (kv-cmd-lindex "outkey" 0) "[LINDEX] Should return the value of the popped key") + (assert-equal 6 (kv-cmd-lindex "inkey" 0) "[LINDEX] Should return the value of the first key") + (assert-equal 6 (kv-cmd-lpoprpush "inkey" "outkey") "[LPOPRPUSH] Should return the element being popped (again)") + ] + +[de test-commands-lpush () + (assert-nil (kv-cmd-lpush) "[LPUSH] Should return NIL if no key is provided") + (assert-nil (kv-cmd-lpush "tasks") "[LPUSH] Should return NIL if only 1 key is provided") + (assert-nil (kv-cmd-lpush "tasks") "[LPUSH] Should return NIL if no elements are provided") + (assert-nil (kv-cmd-lpush "tasks" "element 1") "[LPUSH] Should return NIL if the elements aren't a list") + (off *KV/%stats%/keys) + (off *KV/tasks) + (assert-equal 5 (kv-cmd-lpush "tasks" '("task1" "task2" "task3" "task4" "task5")) "[LPUSH] Should return the length of the new list") + (assert-equal 7 (kv-cmd-lpush "tasks" '("task6" "task7")) "[LPUSH] Should return the extended length of the list") + (assert-equal "task7" (kv-cmd-lindex "tasks" 0) "[LINDEX] Should return the key at index 0") + (assert-equal "task3" (kv-cmd-lindex "tasks" 4) "[LINDEX] Should return the key at index 5") + (assert-equal "task1" (kv-cmd-lindex "tasks" -1) "[LINDEX] Should return the last key") + (assert-equal "task2" (kv-cmd-lindex "tasks" -2) "[LINDEX] Should return the penultimate key") + (assert-nil (kv-cmd-lindex "tasks" 10) "[LINDEX] Should return NIL if no value exists at the index") + (assert-equal 1 (kv-cmd-strlen "%stats%/keys") "[LLEN] Should return the number of keys in the keys list") + (assert-equal "task7" (kv-cmd-lpop "tasks") "[LPOP] Should return the first value added to the tasks list") + (assert-equal 6 (kv-cmd-strlen "tasks") "[LLEN] Should return the number of keys remaining in the tasks list") + ] + +[de test-commands-lrange () + (assert-nil (kv-cmd-lrange) "[LRANGE] Should return NIL if no key is provided") + (assert-nil (kv-cmd-lrange "nonexistant") "[LRANGE] Should return NIL if the key doesn't exist") + (assert-nil (kv-cmd-lrange "inkey" -1 -2) "[LRANGE] Should return NIL if the range has a negative number") + ] + +[de test-commands-lrem () + (assert-equal 0 (kv-cmd-lrem) "[LREM] Should return NIL if no key is provided") + (assert-equal 0 (kv-cmd-lrem "nonexistant") "[LREM] Should return NIL if the key doesn't exist") + (assert-equal 0 (kv-cmd-lrem "inkey" -1 "value") "[LREM] Should return NIL if the count has a negative number") + ] + +[de test-commands-lset () + (assert-nil (kv-cmd-lset) "[LSET] Should return NIL if no key is provided") + (assert-nil (kv-cmd-lset "nonexistant") "[LSET] Should return NIL if the key doesn't exist") + (assert-nil (kv-cmd-lset "inkey" -1 "value" "one") "[LSET] Should return NIL if the index has a negative number") + ] + +[de test-commands-ltrim () + (assert-nil (kv-cmd-ltrim) "[LTRIM] Should return NIL if no key is provided") + (assert-nil (kv-cmd-ltrim "nonexistant") "[LTRIM] Should return NIL if the key doesn't exist") + (assert-nil (kv-cmd-ltrim "inkey" -1 -2) "[LTRIM] Should return NIL if the range has a negative number") + ] + +[de test-commands-rpop () + (assert-nil (kv-cmd-rpop) "[RPOP] Should return NIL if no key is provided") + (assert-nil (kv-cmd-rpop "nonexistant") "[RPOP] Should return NIL if the key doesn't exist") + ] + +[de test-commands-rpoplpush () + (off *KV/inkey) + (off *KV/outkey) + (assert-nil (kv-cmd-rpoplpush) "[RPOPLPUSH] Should return NIL if no source is provided") + (assert-nil (kv-cmd-rpoplpush "inkey") "[RPOPLPUSH] Should return NIL if no dest is provided") + (assert-nil (kv-cmd-rpoplpush "nonexistant") "[RPOPLPUSH] Should return NIL if the key doesn't exist") + (kv-cmd-rpush "inkey2" '(5 6 7 8 9)) + (assert-equal 9 (kv-cmd-rpoplpush "inkey2" "outkey2") "[RPOPLPUSH] Should return the element being popped") + (assert-equal 4 (kv-cmd-strlen "inkey2") "[LLEN] Should list only 4 elements in the source key") + (assert-equal 1 (kv-cmd-strlen "outkey2") "[LLEN] Should list only 1 element in the dest key") + (assert-equal 9 (kv-cmd-lindex "outkey2" 0) "[LINDEX] Should return the value of the popped key") + (assert-equal 5 (kv-cmd-lindex "inkey2" 0) "[LINDEX] Should return the value of the first key") + (assert-equal 8 (kv-cmd-rpoplpush "inkey2" "outkey2") "[RPOPLPUSH] Should return the element being popped (again)") + ] + +[de test-commands-rpush () + (assert-nil (kv-cmd-rpush) "[RPUSH] Should return NIL if no key is provided") + (assert-nil (kv-cmd-rpush "tasks") "[RPUSH] Should return NIL if only 1 key is provided") + (assert-nil (kv-cmd-rpush "tasks") "[RPUSH] Should return NIL if no elements are provided") + (assert-nil (kv-cmd-rpush "tasks" "element 1") "[RPUSH] Should return NIL if the elements aren't a list") + (off *KV/%stats%/keys) + (off *KV/tasks) + (assert-equal 5 (kv-cmd-rpush "tasks" '("task1" "task2" "task3" "task4" "task5")) "[RPUSH] Should return the length of the new list") + (assert-equal 7 (kv-cmd-rpush "tasks" '("task6" "task7")) "[RPUSH] Should return the extended length of the list") + (assert-equal '("task1" "task2") (kv-cmd-lrange "tasks" 0 1) "[LRANGE] Should return the keys in the range 0 1") + (assert-equal "task1" (kv-cmd-lindex "tasks" 0) "[LINDEX] Should return the key at index 0") + (assert-equal "task5" (kv-cmd-lindex "tasks" 4) "[LINDEX] Should return the key at index 5") + (assert-equal "task7" (kv-cmd-lindex "tasks" -1) "[LINDEX] Should return the last key") + (assert-equal "task6" (kv-cmd-lindex "tasks" -2) "[LINDEX] Should return the penultimate key") + (assert-nil (kv-cmd-lindex "tasks" 10) "[LINDEX] Should return NIL if no value exists at the index") + (assert-equal 1 (kv-cmd-strlen "%stats%/keys") "[LLEN] Should return the number of keys in the keys list") + (assert-equal "task1" (kv-cmd-lpop "tasks") "[LPOP] Should return the first value added to the tasks list") + (assert-equal 6 (kv-cmd-strlen "tasks") "[LLEN] Should return the number of keys remaining in the tasks list") + (assert-equal 1 (kv-cmd-lrem "tasks" 3 "task3") "[LREM] Should return the number of keys removed from the task list") + (assert-equal 5 (kv-cmd-strlen "tasks") "[LLEN] Should return the number of keys in the keys list (shortened)") + (assert-equal "OK" (kv-cmd-lset "tasks" 4 "task8") "[LSET] Should return OK if the task value was replaced") + (assert-nil (kv-cmd-lset "tasks" 10 "task8") "[LSET] Should return NIL if the task value can't be replaced") + (assert-equal "task8" (kv-cmd-lindex "tasks" 4) "[LINDEX] Should return the value of the key in the keys list") + (assert-equal "OK" (kv-cmd-ltrim "tasks" 0 1) "[LTRIM] Should return OK when if the task list is trimmed") + (assert-equal 2 (kv-cmd-strlen "tasks") "[LLEN] Should return the number of keys in the keys list (shortened again)") + ] + +[execute + '(test-commands-lindex) + '(test-commands-lpop) + '(test-commands-lpoprpush) + '(test-commands-lpush) + '(test-commands-lrange) + '(test-commands-lrem) + '(test-commands-lset) + '(test-commands-ltrim) + '(test-commands-rpop) + '(test-commands-rpoplpush) + '(test-commands-rpush) + ]