src/lib/database.slate

   1
   2 "for talking to databases through a socket interface"
   3
   4
   5 "
   6 TODO:
   7
   8  - postgres needs better error handling
   9  - accept any type of message at any time
  10  - support for advanced features
  11
  12 "
  13
  14 lobby ensureNamespace: #DB &delegate: False.
  15
  16
  17 DB define: #Database &parents: {Cloneable} &slots: {}.
  18 DB define: #DatabaseCommand &parents: {DB Database} &slots: {}.
  19 DB define: #DatabaseReply &parents: {DB Database} &slots: {}.
  20
  21 DB define: #Postgres &parents: {DB Database} &slots: {#stream -> Nil. #verbose -> False}.
  22
  23 db@(DB Postgres traits) inform: str
  24 [
  25   db verbose ifTrue: [lobby inform: str].
  26 ].
  27
  28
  29 DB define: #PostgresReply &parents: {DB DatabaseReply} &slots: {#type -> Nil. #length -> 0. #response -> Nil}.
  30 DB define: #PostgresCommand &parents: {DB DatabaseCommand. StructMixin}.
  31 DB define: #PostgresStartCommand &parents: {DB PostgresCommand}
  32   &slots: {#length -> 0. #protocol -> 196608. #user -> 'user'. #database -> 'mydb'.
  33            #binaryDescription -> q{(length Int32)
  34                                    (protocol Int32)
  35                                    ('user\0' Fixed)
  36                                    (user CString)
  37                                    ('database\0' Fixed)
  38                                    (database CString)
  39                                    ('\0' Fixed)}}.
  40
  41 DB define: #PostgresPasswordMessage &parents: {DB PostgresCommand}
  42   &slots: {#length -> 0. #password -> ''.
  43            #binaryDescription -> q{('p' Fixed)(length Int32)(password CString)}}.
  44
  45 DB define: #PostgresQueryCommand &parents: {DB PostgresCommand}
  46   &slots: {#length -> 0. #query -> ''.
  47            #binaryDescription -> q{('Q' Fixed)(length Int32)(query CString)}}.
  48
  49
  50 DB define: #PostgresColumnDescription &parents: {Cloneable}
  51  &slots: {#name -> ''. #objectID -> 0. #attributeNumber -> 0. #type -> 0. #typeSize -> 0. #typeModifier -> 0. #format -> 0}.
  52
  53 db@(DB Database traits) newOn: stream
  54 [
  55 overrideThis
  56 ].
  57
  58 db@(DB Database traits) sendCommand: cmd@(DB DatabaseCommand traits)
  59 [
  60 overrideThis
  61 ].
  62
  63 db@(DB Database traits) close
  64 [
  65 overrideThis
  66 ].
  67
  68 reply@(DB DatabaseReply traits) isError
  69 [
  70 overrideThis
  71 ].
  72
  73
  74 " ... Postgresql specific ... "
  75
  76 pc@(DB PostgresCommand traits) littleEndian
  77 [
  78   False
  79 ].
  80
  81 db@(DB Postgres traits) newOn: stream
  82 [ | ret |
  83   ret := db new.
  84   db stream := stream.
  85   db
  86 ].
  87
  88 db@(DB Postgres traits) sendCommand: cmd@(DB PostgresCommand traits)
  89 [
  90   db stream ; cmd packed.
  91   db stream flush.
  92 ].
  93
  94 db@(DB Postgres traits) close
  95 [
  96   db inform: 'closing postgres connection'.
  97   db stream close.
  98 ].
  99
 100 db@(DB Postgres traits) hasReply
 101 [
 102   db stream socket canRead
 103 ].
 104
 105 reply@(DB PostgresReply traits) newType: type response: response
 106 [ | return |
 107   reply new `>> [type := type. length := response size. response := response. ]
 108 ].
 109
 110
 111 db@(DB Postgres traits) connectTo: addr@(Net SocketAddress traits)
 112 [ | socket |
 113   socket := (Net Socket newFor: addr domain type: Net Socket Types Stream protocol: Net Socket Protocols Default).
 114   socket connectTo: addr.
 115   db stream := (Net SocketStream newOn: socket).
 116   db
 117 ].
 118
 119 db@(DB Postgres traits) connectTo: addr@(String traits)
 120 [
 121   db connectTo: (addr as: Net SocketAddress)
 122 ].
 123
 124
 125 reply@(DB PostgresReply traits) isNotice
 126 [
 127   reply type = $N code
 128 ].
 129
 130
 131 reply@(DB PostgresReply traits) isError
 132 [
 133   reply type = $E code
 134 ].
 135
 136 reply@(DB PostgresReply traits) printError
 137 [
 138   reply isError \/ [reply isNotice] ifFalse: [^ Nil].
 139   reply response first = 0
 140         ifTrue: ['Generic Error']
 141         ifFalse: ['Postgres Error: ' ; (reply response allButFirst as: ASCIIString)]
 142 ].
 143
 144
 145 db@(DB Postgres traits) readReply
 146 [ | responseTypeByte responseLength response responseBA |
 147
 148 [
 149   responseTypeByte := db stream next.
 150   db inform: 'Response type:' ; responseTypeByte printString.
 151   responseBA := (db stream next: 4).
 152   db inform: 'Response Length BA:' ; responseBA printString.
 153   responseLength := (responseBA as: Integer &bigEndian: True)."fixme replace with int32 constant size or something"
 154   db inform: 'Response Length:' ; responseLength printString.
 155   response := ((responseLength >= 4)
 156                ifTrue: [(db stream next: responseLength - 4)]
 157                ifFalse: [error: 'malformed message from ' ; db printString]).
 158  "fixme coerce to real structure"
 159   DB PostgresReply newType: responseTypeByte response: response
 160
 161 ] on: Stream Exhaustion do: [ |:e| ^ Nil]
 162
 163 ].
 164
 165 db@(DB Postgres traits) md5Encrypt: pw salt: salt
 166 [
 167   ((pw as: ByteArray) ; (salt as: ByteArray)) md5String
 168 ].
 169
 170 db@(DB Postgres traits) handleLogin: user password: pw
 171 [ | cmd reply reply authCode|
 172   reply := db readReply.
 173   db inform: 'reply: ' ; reply printString.
 174   reply isError ifTrue: [error: 'Login Failed. ' ; reply printError].
 175   reply type ~= $R code ifTrue: [error: 'Reply from server is not an authentication request'].
 176   authCode := ((reply response first: 4) as: Integer &bigEndian: True).
 177   db inform: 'auth code: ' ; authCode printString.
 178   authCode = 0 ifTrue: [ ^ True].
 179   authCode = 5 "md5 with salt on pw"
 180     ifTrue: [db inform: 'salt: ' ; (reply response allButFirst: 4) printString.
 181              cmd := (DB PostgresPasswordMessage new `>> [password := 'md5' ; (db md5Encrypt: (db md5Encrypt: pw salt: user) salt: (reply response allButFirst: 4)). ]).
 182              cmd length := cmd packed size - 1.
 183              db inform: 'sending md5 pw: ' ; cmd password printString.
 184              db sendCommand: cmd.
 185              ^ (db handleLogin: user password: pw)
 186              ]
 187     ifFalse: [error: 'unhandled authentication'].
 188
 189 ].
 190
 191 db@(DB Postgres traits) loginAs: user password: pw &database: database
 192 "Use this command to log into a database"
 193 [ | cmd |
 194   database `defaultsTo: user.
 195   cmd := (DB PostgresStartCommand new `>> [user := user. database := database. ]).
 196   cmd length := cmd packed size.
 197   db sendCommand: cmd.
 198   (db handleLogin: user password: pw) ifTrue: [db inform: 'Login success'].
 199   db waitForQuery.
 200 ].
 201
 202
 203 db@(DB Postgres traits) waitForQuery
 204 "receive messages until readyforquery message"
 205 [ | reply |
 206  [
 207   reply := db readReply.
 208   reply type caseOf: {
 209     $S code -> [db inform: 'parameter status ' ; reply printString].
 210     $E code -> [error: 'Error: ' ; reply printError. ].
 211     $K code -> [db inform: 'Receiving Key data'].
 212     $Z code -> [db inform: 'Ready for query'. ^ True].
 213   } otherwise: [error: 'unexpected reply: ' ; reply printString]
 214  ] loop.
 215 ].
 216
 217
 218
 219 db@(DB Postgres traits) query: query
 220 "Use this to do a simple query on the database"
 221 [ | cmd |
 222   cmd := (DB PostgresQueryCommand new `>> [query := query. ]).
 223   cmd length := cmd packed size - 1.
 224   db sendCommand: cmd.
 225   db readQueryResult
 226 ].
 227
 228 pcd@(DB PostgresColumnDescription traits) createEntryFrom: value
 229 [
 230   pcd format = 0 ifTrue: [value as: ASCIIString]
 231                  ifFalse: [value "fixme.. binary serialize"]
 232 ].
 233
 234 db@(DB Postgres traits) readQueryResult
 235 [ | reply result rowDescription rows reader columnCount|
 236  result := ExtensibleArray new.
 237  rows := ExtensibleArray new.
 238  [
 239   reply := db readReply.
 240   reader := reply response reader.
 241   reply type caseOf: {
 242     $N code -> [db inform: 'Notice: ' ; reply printError].
 243     $C code -> [db inform: 'Command Complete'. result add: {rowDescription. rows}].
 244     $E code -> [error: 'Read Query Result Error: ' ; reply printError. ].
 245     $I code -> [db inform: 'Empty query response.'].
 246     $D code -> [db inform: 'Data row'.
 247                 columnCount := ((reader next: 2) as: Integer &bigEndian: True).
 248                 rows add: ((0 below: columnCount)
 249                                 collect: [ | :col entrySize entry|
 250                                             entrySize: ((reader next: 4) as: Integer &bigEndian: True).
 251                                             entrySize < 0 ifTrue: [Nil]
 252                                                           ifFalse: [(rowDescription at: col) createEntryFrom: (reader next: entrySize)]]).
 253                 ].
 254     $T code -> [db inform: 'Row description.'.
 255                 rowDescription := (Array newSize: ((reader next: 2) as: Integer &bigEndian: True)).
 256                 0 below: rowDescription size do:
 257                   [ | :i column |
 258                      column := DB PostgresColumnDescription new.
 259                      column name := ((reader nextUntil: [ |:c| c = 0]) as: ASCIIString).
 260                      reader next. "null terminator"
 261                      column objectID := ((reader next: 4) as: Integer &bigEndian: True).
 262                      column attributeNumber := ((reader next: 2) as: Integer &bigEndian: True).
 263                      column type := ((reader next: 4) as: Integer &bigEndian: True).
 264                      column typeSize := ((reader next: 2) as: Integer &bigEndian: True).
 265                      column typeModifier := ((reader next: 4) as: Integer &bigEndian: True).
 266                      column format := ((reader next: 2) as: Integer &bigEndian: True).
 267                      db inform: 'column: ' ; column printString.
 268                      rowDescription at: i put: column.
 269                   ]].
 270     $Z code -> [db inform: 'Ready for query'. ^ result].
 271   } otherwise: [error: 'unexpected reply: ' ; reply printString]
 272  ] loop.
 273 ].
 274