X-Git-Url: http://dolda2000.com/gitweb/?a=blobdiff_plain;f=lib%2Fguile%2Fdolcon%2Fui.scm;h=b8ec63ffe34f843c35926dbbaf292148c488dc07;hb=32b515967965a673352cfeedb34bac606df398ef;hp=d6b435499f77529a644dd6640855998315889c68;hpb=ee63cbcbef1dd62fec342c5c60129e3f21011bec;p=doldaconnect.git diff --git a/lib/guile/dolcon/ui.scm b/lib/guile/dolcon/ui.scm index d6b4354..b8ec63f 100644 --- a/lib/guile/dolcon/ui.scm +++ b/lib/guile/dolcon/ui.scm @@ -1,6 +1,23 @@ +; Dolda Connect - Modular multiuser Direct Connect-style client +; Copyright (C) 2007 Fredrik Tolf +; +; 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 2 of the License, or +; (at your option) any later version. +; +; This program is distributed in the hope that it will be useful, +; but WITHOUT ANY WARRANTY; without even the implied warranty of +; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +; GNU General Public License for more details. +; +; You should have received a copy of the GNU General Public License +; along with this program; if not, write to the Free Software +; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + (define-module (dolcon ui)) -(export dc-connect dc-disconnect dc-connected dc-select dc-getresp dc-extract dc-intresp dc-qcmd dc-loginasync dc-lexsexpr) +(export dc-connect dc-disconnect dc-connected dc-select dc-getresp dc-extract dc-intresp dc-qcmd dc-loginasync dc-lexsexpr dc-checkproto) (load-extension "libdolcon-guile" "init_guiledc") @@ -16,15 +33,19 @@ errsym))) (define-public dc-must-connect - (lambda args - (let* ((fd (apply dc-connect args)) (resp (dc-extract (do ((resp (dc-getresp) (dc-getresp))) - ((and resp - (equal? (cdr (assoc 'cmd (dc-extract resp))) ".connect")) - resp) - (dc-select))))) - (if (= (cdr (assoc 'code resp)) 200) - fd + (lambda (host . version) + (let* ((fd (dc-connect host)) + (ores (do ((resp (dc-getresp) (dc-getresp))) + ((and resp + (equal? (cdr (assoc 'cmd (dc-extract resp))) ".connect")) + resp) + (dc-select))) + (resp (dc-extract ores))) + (if (not (= (cdr (assoc 'code resp)) 201)) (throw 'bad-return (cdr (assoc 'code resp)) (cadr (assoc 'resp resp))) + (if (dc-checkproto ores (if (pair? version) (car version) dc-latest)) + fd + (throw 'bad-protocol ores)) ) ) ) @@ -47,10 +68,9 @@ (define-public dc-ecmd (lambda args (let ((tag (dc-qcmd args))) - (if (>= tag 0) - (do ((resp (dc-getresp tag) (dc-getresp tag))) - (resp resp) - (dc-select))) + (do ((resp (dc-getresp tag) (dc-getresp tag))) + (resp resp) + (dc-select)) ) ) )