Commit 311ee9a0 authored by Momchil Ivanov's avatar Momchil Ivanov

Initial commit

parents
1. Introduction
This is a Common Lisp implementation of the RCON protocol described
in Reference [1].
2. Required systems
The systems used by cl-rcon are usocket and babel.
3. Application Interface (API)
The system exports the following functions and methods:
- connect (host port password &optional fn-id)
Returns a rcon object when a successfull connection to the rcon
server on host:port with the password was establised. The port
argument must be an integer, the password argument bust be a
string. The optional argument fn-id specifies a function of the
form f (x) that is used to generate the next packet id given the
last one x. The packet id is 32 bits long.
- shutdown ((rcon rcon))
Closes the rcon connection.
- send ((rcon rcon) str)
Sends the string str to the server and returns the response as a
string.
4. Errors
The system exports the following errors:
read-error
packet-error
malformed-packet-error
packet-order-error
authentication-error
command-too-long-error
5. Examples
Connect to a server and send "status":
(handler-case
(let ((rcon (rcon:connect host port password)))
(format t "~A~&"
(rcon:send rcon "status"))
(rcon:shutdown rcon))
(rcon:authentication-error (c)
(format t "ERROR: Authentication error!~&"))
(usocket:connection-refused-error ()
(format t "ERORR: Connection refused!~&")))
6. RCON client
An implementation of a RCON client program is located in the bin/
folder.
7. Copyright
Copyright (c) 2018 Momchil Ivanov <momchil@xaxo.eu>
All rights reserved.
8. References
1: http://developer.valvesoftware.com/wiki/Source_RCON_Protocol
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;;;
;;;; Copyright (c) 2018 Momchil Ivanov <momchil@xaxo.eu>
;;;;
(in-package :asdf)
(defsystem cl-rcon
:name "cl-rcon"
:author "Momchil Ivanov"
:maintainer "Momchil Ivanov"
:version "1.0"
:license "Copyright (c) 2018"
:description "Common Lisp implementation of the RCON protocol"
:depends-on (alexandria usocket babel)
:serial t
:components((:file "package")
(:file "condition")
(:file "packet")
(:file "send-recv")
(:file "rcon")))
;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;
;; Copyright (c) 2018 Momchil Ivanov <momchil@xaxo.eu>
;;
(in-package :cl-rcon)
(define-condition read-error (error)
((data :initarg :data :reader data)))
(define-condition packet-error (error)
((data :initarg :data :reader data)))
(define-condition malformed-packet-error (packet-error)
((data :initarg :data :reader data)))
(define-condition packet-order-error (packet-error)
((packet :initarg :packet :reader packet)))
(define-condition authentication-error (error)
((text :initarg :text :reader text)))
(define-condition command-too-long-error (error)
((text :initarg :text :reader text)))
;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;
;; Copyright (c) 2018 Momchil Ivanov <momchil@xaxo.eu>
;;
(require :unix-opts)
(require :cl-readline)
(require :cl-rcon)
(defvar *host* "localhost")
(defvar *port* 27015)
(defvar *password* "test")
(defvar *history-file* (concatenate 'string
(namestring (user-homedir-pathname))
".history.rcon"))
(opts:define-opts
(:name :help
:description "print this help text"
:short #\h
:long "help")
(:name :host
:description "hostname"
:short #\H
:long "host"
:arg-parser #'identity
:meta-var "HOST")
(:name :port
:description "port"
:short #\p
:long "port"
:arg-parser #'parse-integer
:meta-var "PORT")
(:name :password
:description "password"
:short #\P
:long "password"
:arg-parser #'identity
:meta-var "PASSWORD")
(:name :exec
:description "command to execute"
:short #\e
:long "exec"
:arg-parser #'identity
:meta-var "COMMAND"))
(defmacro when-option ((options opt) &body body)
`(let ((it (getf ,options ,opt)))
(when it
,@body)))
(defun usage ()
(opts:describe :usage-of "rcon")
(opts:exit))
(defun novelty-check (x y)
(string/= (string-trim " " x)
(string-trim " " y)))
(defun repl (rcon)
(rl:read-history *history-file*)
(loop
for line = (rl:readline :prompt (format nil "-> ")
:add-history t
:novelty-check #'novelty-check)
while line
if (> (length line) 4086)
do (format t "ERROR: Command too long.~&")
(finish-output)
else
do
(format t "~A~&" (rcon:send rcon line)))
(rcon:shutdown rcon)
(rl:write-history *history-file*))
(defun my-quit (&optional (status 0))
"Exit the program returning `status'."
#+sbcl (sb-ext:exit :code status)
#+cmu (unix:unix-exit status)
#+ccl (ccl:quit status)
#+ecl (ext:quit status)
#+clisp (ext:exit status)
#+abcl (extensions:exit :status status)
#+allegro (excl:exit status :quiet t)
#+lispworks (lispworks:quit :status status))
(defun main ()
(multiple-value-bind (options free-args)
(handler-case
(opts:get-opts)
(opts:arg-parser-failed (condition)
(format t "ERROR: cannot parse ~s as argument of ~s~%"
(opts:raw-arg condition)
(opts:option condition))
(my-quit 1))
(opts:unknown-option () (usage)))
(declare (ignore free-args))
(when-option (options :help)
(usage))
(when-option (options :host)
(setf *host* it))
(when-option (options :port)
(setf *port* it))
(when-option (options :password)
(setf *password* it))
(handler-case
(let ((rcon (rcon:connect *host* *port* *password*)))
(if (getf options :exec)
(progn
(format t "~A~&" (rcon:send rcon (getf options :exec))))
(repl rcon))
(rcon:shutdown rcon))
(rcon:authentication-error (c)
(format t "ERROR: Authentication error!~&")
(format t "~A~&" (rcon::text c))
(my-quit 1))
(usocket:connection-refused-error ()
(format t "ERORR: Cannot connect to server!~&")
(my-quit 1)))))
(main)
;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;
;; Copyright (c) 2018 Momchil Ivanov <momchil@xaxo.eu>
;;
(defpackage :cl-rcon
(:nicknames :rcon)
(:use :common-lisp :alexandria)
(:import-from :alexandria :define-constant)
(:export
;; methods and functions
#:connect
#:shutdown
#:send
;; conditions
#:read-error
#:packet-error
#:malformed-packet-error
#:packet-order-error
#:authentication-error
#:command-too-long-error
))
;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;
;; Copyright (c) 2018 Momchil Ivanov <momchil@xaxo.eu>
;;
(in-package :cl-rcon)
(define-constant +packet-types+
'((:auth . 3)
(:auth-response . 2)
(:execcommand . 2)
(:response-value . 0))
:test #'equal
:documentation "List of packet types.")
(defun packet-type-to-int (type)
"Returns integer value of type."
(cdr (assoc type +packet-types+)))
(defun int-to-packet-type (i)
"Returns integer value of type."
(car (rassoc i +packet-types+)))
(defstruct packet
"Packet structure."
(size 0 :type (unsigned-byte 32))
(id 0 :type (unsigned-byte 32))
(type 0 :type (unsigned-byte 32))
(body))
(defun packet (id type body)
"Creates a packet."
(make-packet :size (+ 10 (length body))
:id id
:type (packet-type-to-int type)
:body body))
(defun is-packet-type (packet type)
"Returns t if packet is of type type."
(= (packet-type packet) (packet-type-to-int type)))
(defun write-byte-32-to-byte-array (array i &optional (offset 0))
"Write byte-32 integer in an array of bytes. Use Little-endian."
(setf (aref array offset) (ldb (byte 8 0) i)
(aref array (+ offset 1)) (ldb (byte 8 8) i)
(aref array (+ offset 2)) (ldb (byte 8 16) i)
(aref array (+ offset 3)) (ldb (byte 8 24) i)))
(defun read-byte-array-to-byte-32 (byte-array &optional (offset 0))
"Read a 32-bit integer from an array of bytes. Use Little-endian."
(let ((i 0))
(setf (ldb (byte 8 0) i) (aref byte-array offset)
(ldb (byte 8 8) i) (aref byte-array (+ offset 1))
(ldb (byte 8 16) i) (aref byte-array (+ offset 2))
(ldb (byte 8 24) i) (aref byte-array (+ offset 3)))
i))
(defun well-formed-packet-p (vector &optional (start 0) end)
"Checks if vector contains a well-formed packet."
;; full packet size must be at least 10
(let ((len (- (or end (length vector))
start)))
(when (>= len 14)
;; the size field is 4 bytes long
(let ((size (read-byte-array-to-byte-32 vector start)))
(and
;; packet size is size + 4
(= len (+ 4 size))
;; valid packet type
(int-to-packet-type
(read-byte-array-to-byte-32 vector (+ 8 start)))
;; match the two 0x0 at the end of the packet
(and (= 0 (elt vector (+ 2 size start)))
(= 0 (elt vector (+ 3 size start)))))))))
(defun parse-packet (vector &optional (start 0) end)
"If vector contains a valid packet return it."
(if (well-formed-packet-p vector start end)
(binary-to-packet vector start end)
(error 'malformed-packet-error :data vector)))
;; wrap in eval-when to allow the definition of the
;; +control-packet-string+ constant, otherwise compiler complains with
;; undefined function
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun binary-to-string (vector &optional (start 0) end)
"Converts byte array to string."
(babel:octets-to-string vector :start start :end end :encoding :latin-1)))
(defun string-to-binary (str)
(babel:string-to-octets str :encoding :latin-1))
(defun packet-to-binary (packet)
"Creates an rcon packet.
The structure of the packet is:
Byte | Field | Description
-----------------------------------------------------------
0-3 | Size | 32-bit little-endian Signed Integer
4-7 | ID | 32-bit little-endian Signed Integer
8-11 | Type | 32-bit little-endian Signed Integer
12-X | Body | Null-terminated ASCII String (0x00)
XXXX | Empty String | Null-terminated ASCII String (0x00)
Packet Size
The packet size field is a 32-bit little endian integer, representing
the length of the request in bytes. Note that the packet size field
itself is not included when determining the size of the packet, so the
value of this field is always 4 less than the packet's actual
length. The minimum possible value for packet size is 10:
4 bytes (ID field)
4 bytes (Type field)
at least 1 byte (packet body)
1 byte (empty string terminator).
Packet ID
The packet id field is a 32-bit little endian integer chosen by the client for each request. It may be set to any positive integer. When the server responds to the request, the response packet will have the same packet id as the original request (unless it is a failed SERVERDATA_AUTH_RESPONSE packet - see below.) It need not be unique, but if a unique packet id is assigned, it can be used to match incoming responses to their corresponding requests.
Packet Type
The packet type field is a 32-bit little endian integer, which indicates the purpose of the packet. Its value will always be either 0, 2, or 3, depending on which of the following request/response types the packet represents:
Value String Descriptor
---------------------------------
3 SERVERDATA_AUTH
2 SERVERDATA_AUTH_RESPONSE
2 SERVERDATA_EXECCOMMAND
0 SERVERDATA_RESPONSE_VALUE
Note that the repetition in the above table is not an error: SERVERDATA_AUTH_RESPONSE and SERVERDATA_EXECCOMMAND both have a numeric value of 2.
Packet Body
The packet body field is a null-terminated string encoded in ASCII (i.e. ASCIIZ). Depending on the packet type, it may contain either the RCON password for the server, the command to be executed, or the server's response to a request.
Empty String
The end of a Source RCON Protocol packet is marked by an empty ASCIIZ string - essentially just 8 bits of 0. In languages that do not null-terminate strings automatically, you can simply write 16 bits of 0 immediately after the packet body (8 to terminate the packet body and 8 for the empty string afterwards).
Source: https://developer.valvesoftware.com/wiki/Source_RCON_Protocol
"
(let ((header (make-array 12 :element-type '(unsigned-byte 8))))
(write-byte-32-to-byte-array header (packet-size packet))
(write-byte-32-to-byte-array header (packet-id packet) 4)
(write-byte-32-to-byte-array header (packet-type packet) 8)
(concatenate '(vector (unsigned-byte 8))
header
(string-to-binary (packet-body packet))
#(0) #(0))))
(defun binary-to-packet (vector &optional (start 0) end)
"Creates a packet structure from a binary vector."
(let ((size (- (or end (length vector)) start 4)))
(make-packet :size size
;; the id field is 4 bytes long
:id (read-byte-array-to-byte-32 vector (+ 4 start))
;; the type field is 4 bytes long
:type (read-byte-array-to-byte-32 vector (+ 8 start))
;; body is the rest of the packet excet the last byte
:body (binary-to-string vector (+ 12 start) (+ 2 size start)))))
(define-constant +control-packet-string+
(binary-to-string (make-array 4
:element-type '(unsigned-byte 8)
:initial-contents
'(0 1 0 0)))
:test #'equal)
(defun control-packet-p (packet)
(and (is-packet-type packet :response-value)
(equalp (packet-body packet) +control-packet-string+)))
;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;
;; Copyright (c) 2018 Momchil Ivanov <momchil@xaxo.eu>
;;
(in-package :cl-rcon)
(defclass rcon ()
((socket
:initarg :socket
:accessor socket
:documentation "usocket socket.")
(last-packet-id
:initarg :last-packet-id
:initform 0
:type (unsigned-byte 32)
:accessor last-packet-id
:documentation "id of the last sent packet.")
(last-cmd-packet-id
:initarg :last-cmd-packet-id
:initform 0
:type (unsigned-byte 32)
:accessor last-cmd-packet-id
:documentation "id of the last sent command packet.")
(fn-id
:initarg :fn-id
:initform #'random-id
:accessor fn-id
:documentation "function generating the next packet id given one."
)))
(defun connect (host port password &optional (fn-id #'random-id))
"Creates an RCON connection to HOST:POST and authenticates with
PASSWORD. Returns an RCON object on success."
(check-type password string)
(check-type port integer)
(let* ((socket (socket-connect host port))
(rcon (make-instance 'rcon :socket socket :fn-id fn-id)))
(auth socket password (next-packet-id rcon))
rcon))
(defun random-id (x)
(declare ((unsigned-byte 32) x) (ignore x))
;; 2^32 - 1
(random 4294967295))
(defmethod shutdown ((rcon rcon))
"Closes an RCON connection."
(socket-close (socket rcon)))
(defmethod receive ((rcon rcon))
(receive-cmd (socket rcon) (last-cmd-packet-id rcon) (last-packet-id rcon)))
(defmethod next-packet-id ((rcon rcon))
(setf (last-packet-id rcon) (funcall (fn-id rcon) (last-packet-id rcon))))
(defmethod next-cmd-packet-id ((rcon rcon))
(setf (last-cmd-packet-id rcon) (next-packet-id rcon)))
(defmethod new-send-ids ((rcon rcon))
(let ((x (next-cmd-packet-id rcon)))
(loop for y = (next-packet-id rcon)
until (/= x y)
finally (return (values x y)))))
(defmethod send ((rcon rcon) str)
"Sends an RCON command STR, receives and returns the response."
(check-type str string)
(when (> (length str) 4086)
(error 'command-too-long-error :text str))
(multiple-value-bind (x y)
(new-send-ids rcon)
(send-cmd (socket rcon) str x y))
(receive rcon))
;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;
;; Copyright (c) 2018 Momchil Ivanov <momchil@xaxo.eu>
;;
(in-package :cl-rcon)
(defvar *debug* nil)
(defun socket-connect (host port)
"Connect to a rcon server on host:port."
(usocket:socket-connect host port
:protocol :stream
:element-type '(unsigned-byte 8)))
(defun socket-close (socket)
"Closes the socket."
(usocket:socket-close socket))
(defun send-packet (socket packet &optional (finish-output t))
"Sends packet to socket. Calls finish-output if finish-output is t
to flush the output stream."
(let* ((vector (packet-to-binary packet))
(stream (usocket:socket-stream socket))
(res (write-sequence vector stream)))
(when finish-output (finish-output stream))
(when *debug*
(format t "send: ~A~%" packet)
(format t "send: ~A~%" vector))
res))
(defun send-cmd (socket str &optional (id-cmd 0) (id-xxx 1))
"Sends str in one packet. Sends an empty packet afterwards to
implement multiple-packet responses."
(send-packet socket (packet id-cmd :execcommand str))
(send-packet socket (packet id-xxx :response-value "")))
(defun send-auth (socket password &optional (id 0))
"Sends an authentication packet."
(send-packet socket (packet id :auth password)))
(defun read-bytes (stream n)
"Receives a data from stream."
(let ((vector (make-array n :element-type '(unsigned-byte 8))))
;; detect EOF when read-sequence does not return the number of
;; bytes we wanted to read
(if (eq n (read-sequence vector stream))
(progn
(when *debug* (format t "rcvd: ~A~%" vector))
vector)
(error 'read-error :data (subseq vector 0 n)))))
(defun receive-packet (socket)
"Reads and returns a packet from socket."
(let* ((stream (usocket:socket-stream socket))
(vector (read-bytes stream 4)))
(when vector
(let* ((size (read-byte-array-to-byte-32 vector))
(vector2 (read-bytes stream size)))
(setf vector (concatenate '(vector (unsigned-byte 8)) vector vector2))
(let ((packet (parse-packet vector)))
(when *debug* (format t "rcvd: ~A~%" packet))
packet)))))
(defun list-to-string (lst)
(format nil "~{~a~}" lst))
(defun receive-cmd (socket &optional (id-cmd 0) (id-xxx 1))
"Receives a response to a send command, implements multiple-packet
response."
(let ((packets (loop for packet = (receive-packet socket)
while packet
while (= (packet-id packet) id-cmd)
while (is-packet-type packet :response-value)
collect packet)))
;; receive control packet
(let ((packet (receive-packet socket)))
(unless (control-packet-p packet)
(error 'packet-order-error :packet packet)))
(list-to-string (mapcar #'packet-body packets))))
(defun auth (socket password &optional (id 0))
"Sends authentication packet and receives authentication response
from the server. Returns nil on error, t otherwise."
(send-auth socket password id)
(handler-case
(let* ((a (receive-packet socket))
(b (receive-packet socket)))
(or
(and a b
(is-packet-type a :response-value)
(is-packet-type b :auth-response)
(= (packet-id a) id)
(= (packet-id b) id))
(error 'authentication-error :text (packet-body a))))
(read-error ()
;; in case the server banned us it is not responding at all,
;; therefore catch read-error and emit authentication-error
(error 'authentication-error
:text "Server closed the connection unexpectedly. Probably ban."))))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment