[myserver-commit] [2989] Support other control protocol commands.

[Giuseppe Scrivano]

Revision: 2989
          http://svn.sv.gnu.org/viewvc/?view=rev&root=myserver&revision=2989
Author:   gscrivano
Date:     2009-01-31 23:00:24 +0000 (Sat, 31 Jan 2009)

Log Message:
-----------
Support other control protocol commands.

Modified Paths:
--------------
    trunk/misc/el_control_client/myserver-control.el

Modified: trunk/misc/el_control_client/myserver-control.el
===================================================================
--- trunk/misc/el_control_client/myserver-control.el    2009-01-31 19:05:36 UTC 
(rev 2988)
+++ trunk/misc/el_control_client/myserver-control.el    2009-01-31 23:00:24 UTC 
(rev 2989)
@@ -1,5 +1,5 @@
 ;; MyServer
-;; Copyright (C) 2008 Free Software Foundation, Inc.
+;; Copyright (C) 2008, 2009 Free Software Foundation, Inc.
 ;; This program is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;; the Free Software Foundation; either version 3 of the License, or
@@ -24,6 +24,10 @@
 ;;
 ;;(myserver-control-end my-proc)
 
+(defvar myserver-control-user "ADMIN")
+(defvar myserver-control-password "ADMIN")
+(defvar myserver-control-connection "Keep-Alive")
+
 (defun myserver-control-init (server port)
   "Initialize a connection to the specified SERVER using the PORT."
   (when (get-buffer "myserver") (kill-buffer "myserver"))
@@ -33,38 +37,53 @@
                                        port)))
     (starttls-negotiate proc)
     proc))
-    
 
+
 (defun myserver-control-send-message (proc msg)
   "Send the message MSG to the specified PROC and
    return the response header lines."
   (process-send-string proc msg)
-  
+      
   (with-current-buffer "myserver"
-    (let ((i 3) 
+    (let ((i 3)
           (np 0)
           (start 0)
           (curr nil)
+          (len 0)
           (res '()))
       (while (and (> i 0)
                   (not (search-forward "\r\n\r\n" nil t)))
+        (goto-char (point-max))
         (myserver-control-wait-for-data my-proc 2)
         (setq i (1- i))
-        (goto-char (point-min))  )
-      
+        (goto-char (point-min)))
+
+      (set-buffer "myserver")
       (goto-char (point-min))
-      (setq res (append res (list (buffer-substring 2 (- (search-forward 
"\r\n" nil t) 2)))))
-      
+      (setq res (list (buffer-substring 2 (- (search-forward "\r\n" nil t) 
2))))
+
       (while (progn
                (setq start (1+ (point)))
                (setq np (- (search-forward "\r" nil t) 1))
                (setq curr (buffer-substring start np))
                (> (- np start) 4))
         
-        (setq res (append res (list curr)))) 
-      res
-      )))
+        (setq res (append res (list curr))))
+      
+      (setq res (mapcar 'split-string res))
+      (setq len (string-to-number (cadr (assoc "LEN" res))))
 
+      (setq i 3)
+      (while (and (> i 0)
+                  (< len (- (buffer-size) np)))
+        (goto-char (point-max))
+        (myserver-control-wait-for-data my-proc 2)
+        (setq i (1- i)))
+
+
+      (list res (buffer-substring (+ np 2) (+ 1 (buffer-size)))))))
+
+
 (defun myserver-control-wait-for-data (proc sec)
   "Read data from the process using a timeout of SEC seconds."
   (accept-process-output proc sec 0))
@@ -74,4 +93,23 @@
   (delete-process proc))
 
 
+(defun myserver-control-show-connections (proc)
+  (let ((r (myserver-control-send-message proc (concat "/SHOWCONNECTIONS 
CONTROL/1.0 \r\n"
+                                                       "/AUTH " 
myserver-control-user ":" myserver-control-password "\r\n"
+                                                       "/CONNECTION " 
myserver-control-connection "\r\n\r\n"))))
+    
+    (mapcar (lambda (x) (split-string x " - ")) (split-string (cadr r) 
"\r\n"))))
+
+
+(defun myserver-control-reboot (proc)
+  (myserver-control-send-message proc (concat "/REBOOT CONTROL/1.0 \r\n"
+                                              "/AUTH " myserver-control-user 
":" myserver-control-password "\r\n"
+
+                                              "/CONNECTION " 
myserver-control-connection "\r\n\r\n")))
+(defun myserver-control-version (proc)
+  (cadr (myserver-control-send-message proc (concat "/VERSION CONTROL/1.0 \r\n"
+                                                    "/AUTH " 
myserver-control-user ":" myserver-control-password "\r\n"
+                                                    "/CONNECTION " 
myserver-control-connection "\r\n\r\n"))))
+
+
 (provide 'myserver-control)