Instantly share code, notes, and snippets.

Embed
What would you like to do?
LMDB -- First version of Redis written in Tcl
# LVDB - LLOOGG Memory DB
# Copyriht (C) 2009 Salvatore Sanfilippo <antirez@gmail.com>
# All Rights Reserved
# TODO
# - cron with cleanup of timedout clients, automatic dump
# - the dump should use array startsearch to write it line by line
# and may just use gets to read element by element and load the whole state.
# - 'help','stopserver','saveandstopserver','save','load','reset','keys' commands.
# - ttl with milliseconds resolution 'ttl a 1000'. Check ttl in dump!
# - cluster. Act as master, send write ops to all servers, get from one at random. Auto-serialization.
# - 'hold' and 'continue' command, for sync in cluster mode
# - auto-sync, consider lazy copy or log of operations to re-read at start
# - client timeout
# - save dump in temp file.[clock ticks] than rename it
package require Tclx ;# For [fork]
array set ::clients {}
array set ::state {}
array set ::readlen {}
array set ::readbuf {}
array set ::db {}
array set ::ttl {}
set ::dirty 0
set ::lastsaved 0
set ::listensocket {}
signal -restart block SIGCHLD
# the K combinator is using for Tcl object refcount hacking
# in order to avoid useless object copy.
proc K {x y} {
set x
}
proc headappend {var e} {
upvar 1 $var l
set l [lreplace [K $l [set l {}]] -1 -1 $e]
}
proc log msg {
puts stderr "[clock format [clock seconds]]\] $msg "
}
proc warning msg {
log "*** WARNING: $msg"
}
proc writemsg {fd msg} {
puts -nonewline $fd $msg
puts -nonewline $fd "\r\n"
}
proc resetclient {fd} {
set ::clients($fd) [clock seconds]
set ::state($fd) {}
set ::readlen($fd) 0
set ::readbuf($fd) {}
}
proc accept {fd addr port} {
resetclient $fd
fconfigure $fd -blocking 0 -translation binary -encoding binary
fileevent $fd readable [list readrequest $fd]
}
proc readrequest fd {
if [eof $fd] {
closeclient $fd
return
}
# Handle bulk read
if {$::state($fd) ne {}} {
set buf [read $fd [expr {$::readlen($fd)-[string length $::readbuf($fd)]}]]
append ::readbuf($fd) $buf
if {[string length $::readbuf($fd)] >= $::readlen($fd)} {
set ::readbuf($fd) [string range $::readbuf($fd) 0 end-2]
lappend ::state($fd) $::readbuf($fd)
cmd_[lindex $::state($fd) 0] $fd $::state($fd)
}
return
}
# Handle first line request
set req [string trim [gets $fd] "\r\n "]
if {$req eq {}} return
# Process command
set args [split $req]
set cmd [string tolower [lindex $args 0]]
foreach ct $::cmdtable {
if {$cmd eq [lindex $ct 0] && [llength $args] == [lindex $ct 1]} {
if {[lindex $ct 2] eq {inline}} {
cmd_$cmd $fd $args
} else {
set readlen [lindex $args end]
if {$readlen < 0 || $readlen > 1024*1024} {
writemsg $fd "protocol error: invalid bulk read length"
closeclient $fd
return
}
bulkread $fd [lrange $args 0 end-1] $readlen
}
return
}
}
writemsg $fd "protocol error: invalid command '$cmd'"
closeclient $fd
}
proc bulkread {fd argv len} {
set ::state($fd) $argv
set ::readlen($fd) [expr {$len+2}] ;# Add two bytes for CRLF
}
proc closeclient fd {
unset ::clients($fd)
unset ::state($fd)
unset ::readlen($fd)
unset ::readbuf($fd)
close $fd
}
proc cron {} {
# Todo timeout clients timeout
puts "lmdb: [array size ::db] keys, [array size ::clients] clients, dirty: $::dirty, lastsaved: $::lastsaved"
after 1000 cron
}
set ::cmdtable {
{ping 1 inline}
{quit 1 inline}
{set 3 bulk}
{get 2 inline}
{exists 2 inline}
{delete 2 inline}
{incr 2 inline}
{decr 2 inline}
{lpush 3 bulk}
{rpush 3 bulk}
{save 1 inline}
{bgsave 1 inline}
}
proc okreset {fd {msg OK}} {
writemsg $fd $msg
flush $fd
resetclient $fd
}
proc cmd_ping {fd argv} {
writemsg $fd "PONG"
flush $fd
resetclient $fd
}
proc cmd_quit {fd argv} {
okreset $fd
closeclient $fd
}
proc cmd_set {fd argv} {
set ::db([lindex $argv 1]) [lindex $argv 2]
incr ::dirty
okreset $fd
}
proc cmd_get {fd argv} {
if {[info exists ::db([lindex $argv 1])]} {
set val $::db([lindex $argv 1])
} else {
set val {}
}
writemsg $fd [string length $val]
writemsg $fd $val
flush $fd
resetclient $fd
}
proc cmd_exists {fd argv} {
if {[info exists ::db([lindex $argv 1])]} {
set res 1
} else {
set res 0
}
writemsg $fd $res
flush $fd
resetclient $fd
}
proc cmd_delete {fd argv} {
unset -nocomplain -- ::db([lindex $argv 1])
incr ::dirty
writemsg $fd "OK"
flush $fd
resetclient $fd
}
proc cmd_incr {fd argv} {
cmd_incrdecr $fd $argv 1
}
proc cmd_decr {fd argv} {
cmd_incrdecr $fd $argv -1
}
proc cmd_incrdecr {fd argv n} {
if {[catch {
incr ::db([lindex $argv 1]) $n
}]} {
set ::db([lindex $argv 1]) $n
}
incr ::dirty
writemsg $fd $::db([lindex $argv 1])
flush $fd
resetclient $fd
}
proc cmd_lpush {fd argv} {
cmd_push $fd $argv -1
}
proc cmd_rpush {fd argv} {
cmd_push $fd $argv 1
}
proc cmd_push {fd argv dir} {
if {[catch {
llength $::db([lindex $argv 1])
}]} {
if {![info exists ::db([lindex $argv 1])]} {
set ::db([lindex $argv 1]) {}
} else {
set ::db([lindex $argv 1]) [split $::db([lindex $argv 1])]
}
}
if {$dir == 1} {
lappend ::db([lindex $argv 1]) [lindex $argv 2]
} else {
headappend ::db([lindex $argv 1]) [lindex $argv 2]
}
incr ::dirty
okreset $fd
}
proc savedb {} {
set err [catch {
set fp [open "saved.lmdb" w]
fconfigure $fp -encoding binary -translation binary
set search [array startsearch ::db]
set elements [array size ::db]
for {set i 0} {$i < $elements} {incr i} {
set key [array nextelement ::db $search]
set val $::db($key)
puts $fp "[string length $key] [string length $val]"
puts -nonewline $fp $key
puts -nonewline $fp $val
}
close $fp
set ::dirty 0
set ::lastsaved [clock seconds]
} errmsg]
if {$err} {return $errmsg}
return {}
}
proc backgroundsave {} {
unset -nocomplain ::dbcopy
array set ::dbcopy [array get ::db]
}
proc cmd_bgsave {fd argv} {
backgroundsave
okreset $fd
}
proc cmd_save {fd argv} {
set errmsg [savedb]
if {$errmsg ne {}} {
okreset $fd "ER"
warning "Error trying to save: $errmsg"
} else {
okreset $fd
log "State saved"
}
}
proc loaddb {} {
set err [catch {
set fp [open "saved.lmdb"]
fconfigure $fp -encoding binary -translation binary
set count 0
while {[gets $fp len] != -1} {
set key [read $fp [lindex $len 0]]
set val [read $fp [lindex $len 1]]
set ::db($key) $val
incr count
}
log "$count keys loaded"
close $fp
} errmsg]
if {$err} {
warning "Loading DB from file: $errmsg"
}
return $err
}
proc main {} {
log "Server started"
if {[file exists saved.lmdb]} loaddb
set ::dirty 0
set ::listensocket [socket -server accept 6379]
cron
}
main
vwait forever
@antirez

This comment has been minimized.

Show comment
Hide comment
@antirez

antirez Apr 28, 2017

This was the first version of Redis... We used it inside our startup, with Fabio Pitrola. I found it while tweeting about the fact that now Fabio, the first user of Redis ever together with me, runs an icecream shop in Barcelona (you should try it btw, http://gelateriasiciliana.com/). Tried my luck with gmail and there was this email from 2009!

Note how in a 300 line so of code trow-away there was already most of Redis main ideas:

  1. Fork() to persist, even if this was an higher level language.
  2. Data structures: this version implements list pop/push primitives.
  3. The protocol is the Redis v1 protocol, it's no longer the same nowadays, but the prefixed-length idea + human readable is there.
  4. Many names and/or comments in the code even resemble the names of modern Redis parts / functions.

So from the POV of programming creation process, it looks like that a short trow-away can already have hints about how to perform future developments, by extending each part that can be, in the original throw away, just a comment.

Email date is: 4 Feb 2009.

Owner

antirez commented Apr 28, 2017

This was the first version of Redis... We used it inside our startup, with Fabio Pitrola. I found it while tweeting about the fact that now Fabio, the first user of Redis ever together with me, runs an icecream shop in Barcelona (you should try it btw, http://gelateriasiciliana.com/). Tried my luck with gmail and there was this email from 2009!

Note how in a 300 line so of code trow-away there was already most of Redis main ideas:

  1. Fork() to persist, even if this was an higher level language.
  2. Data structures: this version implements list pop/push primitives.
  3. The protocol is the Redis v1 protocol, it's no longer the same nowadays, but the prefixed-length idea + human readable is there.
  4. Many names and/or comments in the code even resemble the names of modern Redis parts / functions.

So from the POV of programming creation process, it looks like that a short trow-away can already have hints about how to perform future developments, by extending each part that can be, in the original throw away, just a comment.

Email date is: 4 Feb 2009.

@tomas-fp

This comment has been minimized.

Show comment
Hide comment
@tomas-fp

tomas-fp Apr 28, 2017

@antirez That's a nice story. Also, the link to "la gelateria" is invalid, btw.

tomas-fp commented Apr 28, 2017

@antirez That's a nice story. Also, the link to "la gelateria" is invalid, btw.

@antirez

This comment has been minimized.

Show comment
Hide comment
@antirez

antirez Apr 28, 2017

Thank you @tomas-fp, I was very happy to discover it since I did not ever remember at this point if the story I told to people about the first Tcl version having already lists was true, but actually it was far more advanced than that: there was already the concept of fork() for persistency for example, and certain comments and function names totally resamble modern Redis names / parts.

Owner

antirez commented Apr 28, 2017

Thank you @tomas-fp, I was very happy to discover it since I did not ever remember at this point if the story I told to people about the first Tcl version having already lists was true, but actually it was far more advanced than that: there was already the concept of fork() for persistency for example, and certain comments and function names totally resamble modern Redis names / parts.

@agounaris

This comment has been minimized.

Show comment
Hide comment
@agounaris

agounaris Apr 30, 2017

Lovely, its always amazing to see how a product evolved from a "very simple" program. Also this implementation reminds me something that apparently a lot forger these days. People are lost in which framework to use, which programming language, functional programming, DDD, TDD, BDD, XXD etc but here we are, redis v1 in tcl doing the job and moving the development forward. Nearly every successful software project out there is made with whatever the developer felt comfortable with at the time of the development.

Thx for sharing this.

agounaris commented Apr 30, 2017

Lovely, its always amazing to see how a product evolved from a "very simple" program. Also this implementation reminds me something that apparently a lot forger these days. People are lost in which framework to use, which programming language, functional programming, DDD, TDD, BDD, XXD etc but here we are, redis v1 in tcl doing the job and moving the development forward. Nearly every successful software project out there is made with whatever the developer felt comfortable with at the time of the development.

Thx for sharing this.

@SonOfLilit

This comment has been minimized.

Show comment
Hide comment
@SonOfLilit

SonOfLilit Apr 30, 2017

If you enjoyed reading this, you might enjoy reading git's first self-hosted commit: git/git@e83c516

SonOfLilit commented Apr 30, 2017

If you enjoyed reading this, you might enjoy reading git's first self-hosted commit: git/git@e83c516

@garrettwilkin

This comment has been minimized.

Show comment
Hide comment
@garrettwilkin

garrettwilkin Apr 30, 2017

SOMEONE ELSE ON THE INTERNET HAS USED TCL??!?!

I thought I was the only one.

garrettwilkin commented Apr 30, 2017

SOMEONE ELSE ON THE INTERNET HAS USED TCL??!?!

I thought I was the only one.

@sammy007

This comment has been minimized.

Show comment
Hide comment
@sammy007

sammy007 commented Apr 30, 2017

@antirez

This comment has been minimized.

Show comment
Hide comment
@antirez

antirez Apr 30, 2017

@sammy007 no problem I've no intention of using the name :-) I just left the original name, that btw predates the LMDB from Symas, but anyway the Symas folks could never know there was another LMDB since was never released in this form before. Later I tought that LMDB was too much of an acronym and that Redis was much more a name that users could remember/like, so I changed it with the C rewrite.

Owner

antirez commented Apr 30, 2017

@sammy007 no problem I've no intention of using the name :-) I just left the original name, that btw predates the LMDB from Symas, but anyway the Symas folks could never know there was another LMDB since was never released in this form before. Later I tought that LMDB was too much of an acronym and that Redis was much more a name that users could remember/like, so I changed it with the C rewrite.

@sammy007

This comment has been minimized.

Show comment
Hide comment
@sammy007

sammy007 May 1, 2017

@antirez Finally I just noticed date at line 2 :)

sammy007 commented May 1, 2017

@antirez Finally I just noticed date at line 2 :)

@cardiffman

This comment has been minimized.

Show comment
Hide comment
@cardiffman

cardiffman May 1, 2017

@garrettwilkin AOL Server uses TCL. https://github.com/aolserver. Also everyone who uses good old expect is using TCL.

cardiffman commented May 1, 2017

@garrettwilkin AOL Server uses TCL. https://github.com/aolserver. Also everyone who uses good old expect is using TCL.

@Snesi

This comment has been minimized.

Show comment
Hide comment
@Snesi

Snesi May 4, 2017

Dude I will definitely go get some ice-cream there! XD

Snesi commented May 4, 2017

Dude I will definitely go get some ice-cream there! XD

@aviggiano

This comment has been minimized.

Show comment
Hide comment
@aviggiano

aviggiano May 5, 2017

The idea behind the cmdtable is still the same (now a struct redisCommand redisCommandTable[])

aviggiano commented May 5, 2017

The idea behind the cmdtable is still the same (now a struct redisCommand redisCommandTable[])

@devdimi

This comment has been minimized.

Show comment
Hide comment
@devdimi

devdimi May 11, 2017

This shows that every complex system has evolved from simple system that works and does something useful.
I was recently reading Systemantics book recommended by some famous programmers - here is a quote from it.
"A complex system that works is invariably found to have evolved from a simple system that worked. A complex system designed from scratch never works and cannot be patched up to make it work. You have to start over with a working simple system." – John Gall Systemantics (1975, p.71)

devdimi commented May 11, 2017

This shows that every complex system has evolved from simple system that works and does something useful.
I was recently reading Systemantics book recommended by some famous programmers - here is a quote from it.
"A complex system that works is invariably found to have evolved from a simple system that worked. A complex system designed from scratch never works and cannot be patched up to make it work. You have to start over with a working simple system." – John Gall Systemantics (1975, p.71)

@lvlds

This comment has been minimized.

Show comment
Hide comment
@lvlds

lvlds commented May 30, 2017

Awesome

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment