Skip to content
This repository was archived by the owner on Mar 2, 2020. It is now read-only.

Commit 53a0ec8

Browse files
author
gpadd
committedApr 13, 2013
Added TLS support.
This is a pretty ugly hack that needs to be cleaned up sooner or later.
1 parent 5f54bf8 commit 53a0ec8

18 files changed

+437
-69
lines changed
 

‎.gitignore

+9-1
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,15 @@
1+
*~
2+
*.db
13
*.go
24
build-aux/
35
autom4te.cache/
46
configure
57
config.status
6-
*.in
8+
Makefile.in
79
Makefile
10+
bot-data
11+
aclocal.m4
12+
config.log
13+
doc/api.info
14+
env
15+
irc/config.scm

‎AUTHORS

+1
Original file line numberDiff line numberDiff line change
@@ -1 +1,2 @@
11
Bas Smit "fbs" (fbs.devv@gmail.com)
2+
Andreas W "add^_" (unknown.areth@gmail.com)

‎IDEAS

+4
Original file line numberDiff line numberDiff line change
@@ -8,3 +8,7 @@ limit lines to 512 char max.
88
- Log handler
99
Send all raw in/output through a special logging procedure
1010
(lambda (direction str) ..).
11+
12+
- SSL support
13+
14+
- Bot

‎INSTALL

+11
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,11 @@
1+
################################################
2+
##
3+
## guile-irc
4+
##
5+
################################################
6+
7+
8+
autoreconf -vif
9+
./configure
10+
make
11+
sudo make install

‎Makefile.am

+18-25
Original file line numberDiff line numberDiff line change
@@ -1,30 +1,23 @@
1-
GUILE_FLAGS = -Wunbound-variable -Warity-mismatch -Wformat
1+
include guile.am
22

3-
SCM_SOURCES = \
4-
channel.scm \
5-
error-code.scm \
6-
error.scm \
7-
handlers.scm \
8-
irc.scm \
9-
message.scm \
10-
tagged-hook.scm
3+
moddir=$(prefix)/share/guile/site/2.0
4+
godir=$(libdir)/guile/2.0/site-ccache
115

12-
GOBJECTS = $(SCM_SOURCES:%.scm=%.go)
6+
SOURCES = \
7+
irc/config.scm \
8+
irc/channel.scm \
9+
irc/error.scm \
10+
irc/error-code.scm \
11+
irc/message.scm \
12+
irc/tagged-hook.scm \
13+
irc/irc.scm \
14+
irc/handlers.scm
1315

14-
scmdir = $(GUILE_SITE)/irc/
15-
godir = $(libdir)/guile/20/ccache/irc/
16+
EXTRA_DIST += env.in
1617

17-
nobase_scm_DATA = $(SCM_SOURCES)
18-
nobase_go_DATA = $(GOBJECTS)
18+
info_TEXINFOS = doc/api.texi
1919

20-
guile_install_go_files = install-nobase_goDATA
21-
$(guile_install_go_files): install-nobase_scmDATA
22-
23-
SUFFIXES = .scm .go
24-
CLEANFILES = $(GOBJECTS)
25-
26-
SUBDIRS = doc
27-
AUTOMAKE_OPTIONS = subdir-objects
28-
29-
.scm.go:
30-
$(GUILE_TOOLS) compile $(GUILE_FLAGS) -o "$@" "$<"
20+
TESTS = \
21+
test/message-test.scm
22+
TESTS_ENVIRONMENT = $(top_builddir)/env $(GUILE) --no-auto-compile
23+
EXTRA_DIST += $(TESTS) $(info_TEXINFOS)

‎README.md

+3-6
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,7 @@ An irc library for [GNU guile](http://www.gnu.org/software/guile/).
1515

1616
2. Create an irc object.
1717
```scheme
18-
(define irc (make-irc #:nick "bot" #:server "localhost" #:port 6667))
18+
(define irc (make-irc #:nick "bot" #:server "localhost" #:port 6697))
1919
```
2020

2121
3. Install some message handlers.
@@ -25,9 +25,10 @@ An irc library for [GNU guile](http://www.gnu.org/software/guile/).
2525
(install-printer! irc)
2626
```
2727

28-
4. Connect to the server and register.
28+
4. Connect to the server with tls and register.
2929
```scheme
3030
(do-connect irc)
31+
(do-wrap-port/tls irc)
3132
(do-register irc)
3233
```
3334

@@ -41,8 +42,4 @@ An irc library for [GNU guile](http://www.gnu.org/software/guile/).
4142
(do-runloop irc)
4243
```
4344

44-
## API
45-
46-
[API reference page](http://fbs.github.com/guile-irc/)
47-
4845

‎acinclude.m4

+202
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,202 @@
1+
## Autoconf macros for working with Guile.
2+
##
3+
## Copyright (C) 1998,2001, 2006, 2010 Free Software Foundation, Inc.
4+
##
5+
## This library is free software; you can redistribute it and/or
6+
## modify it under the terms of the GNU Lesser General Public License
7+
## as published by the Free Software Foundation; either version 3 of
8+
## the License, or (at your option) any later version.
9+
##
10+
## This library is distributed in the hope that it will be useful,
11+
## but WITHOUT ANY WARRANTY; without even the implied warranty of
12+
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13+
## Lesser General Public License for more details.
14+
##
15+
## You should have received a copy of the GNU Lesser General Public
16+
## License along with this library; if not, write to the Free Software
17+
## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
18+
## 02110-1301 USA
19+
20+
# serial 10
21+
22+
## Index
23+
## -----
24+
##
25+
## GUILE_PROGS -- set paths to Guile interpreter, config and tool programs
26+
## GUILE_FLAGS -- set flags for compiling and linking with Guile
27+
## GUILE_SITE_DIR -- find path to Guile "site" directory
28+
## GUILE_CHECK -- evaluate Guile Scheme code and capture the return value
29+
## GUILE_MODULE_CHECK -- check feature of a Guile Scheme module
30+
## GUILE_MODULE_AVAILABLE -- check availability of a Guile Scheme module
31+
## GUILE_MODULE_REQUIRED -- fail if a Guile Scheme module is unavailable
32+
## GUILE_MODULE_EXPORTS -- check if a module exports a variable
33+
## GUILE_MODULE_REQUIRED_EXPORT -- fail if a module doesn't export a variable
34+
35+
## Code
36+
## ----
37+
38+
## NOTE: Comments preceding an AC_DEFUN (starting from "Usage:") are massaged
39+
## into doc/ref/autoconf-macros.texi (see Makefile.am in that directory).
40+
41+
# GUILE_PROGS -- set paths to Guile interpreter, config and tool programs
42+
#
43+
# Usage: GUILE_PROGS
44+
#
45+
# This macro looks for programs @code{guile}, @code{guile-config} and
46+
# @code{guile-tools}, and sets variables @var{GUILE}, @var{GUILE_CONFIG} and
47+
# @var{GUILE_TOOLS}, to their paths, respectively. If either of the first two
48+
# is not found, signal error.
49+
#
50+
# The variables are marked for substitution, as by @code{AC_SUBST}.
51+
#
52+
AC_DEFUN([GUILE_PROGS],
53+
[AC_PATH_PROG(GUILE,guile)
54+
if test "$GUILE" = "" ; then
55+
AC_MSG_ERROR([guile required but not found])
56+
fi
57+
AC_SUBST(GUILE)
58+
AC_PATH_PROG(GUILE_CONFIG,guile-config)
59+
if test "$GUILE_CONFIG" = "" ; then
60+
AC_MSG_ERROR([guile-config required but not found])
61+
fi
62+
AC_SUBST(GUILE_CONFIG)
63+
AC_PATH_PROG(GUILE_TOOLS,guile-tools)
64+
AC_SUBST(GUILE_TOOLS)
65+
])
66+
67+
# GUILE_FLAGS -- set flags for compiling and linking with Guile
68+
#
69+
# Usage: GUILE_FLAGS
70+
#
71+
# This macro runs the @code{guile-config} script, installed with Guile, to
72+
# find out where Guile's header files and libraries are installed. It sets
73+
# two variables, @var{GUILE_CFLAGS} and @var{GUILE_LDFLAGS}.
74+
#
75+
# @var{GUILE_CFLAGS}: flags to pass to a C or C++ compiler to build code that
76+
# uses Guile header files. This is almost always just a @code{-I} flag.
77+
#
78+
# @var{GUILE_LDFLAGS}: flags to pass to the linker to link a program against
79+
# Guile. This includes @code{-lguile} for the Guile library itself, any
80+
# libraries that Guile itself requires (like -lqthreads), and so on. It may
81+
# also include a @code{-L} flag to tell the compiler where to find the
82+
# libraries.
83+
#
84+
# The variables are marked for substitution, as by @code{AC_SUBST}.
85+
#
86+
AC_DEFUN([GUILE_FLAGS],
87+
[AC_REQUIRE([GUILE_PROGS])dnl
88+
AC_MSG_CHECKING([libguile compile flags])
89+
GUILE_CFLAGS="`$GUILE_CONFIG compile`"
90+
AC_MSG_RESULT([$GUILE_CFLAGS])
91+
AC_MSG_CHECKING([libguile link flags])
92+
GUILE_LDFLAGS="`$GUILE_CONFIG link`"
93+
AC_MSG_RESULT([$GUILE_LDFLAGS])
94+
AC_SUBST(GUILE_CFLAGS)
95+
AC_SUBST(GUILE_LDFLAGS)
96+
])
97+
98+
# GUILE_SITE_DIR -- find path to Guile "site" directory
99+
#
100+
# Usage: GUILE_SITE_DIR
101+
#
102+
# This looks for Guile's "site" directory, usually something like
103+
# PREFIX/share/guile/site, and sets var @var{GUILE_SITE} to the path.
104+
# Note that the var name is different from the macro name.
105+
#
106+
# The variable is marked for substitution, as by @code{AC_SUBST}.
107+
#
108+
AC_DEFUN([GUILE_SITE_DIR],
109+
[AC_REQUIRE([GUILE_PROGS])dnl
110+
AC_MSG_CHECKING(for Guile site directory)
111+
GUILE_SITE=`[$GUILE_CONFIG] info sitedir`
112+
if test "$GUILE_SITE" = ""; then
113+
GUILE_SITE=`[$GUILE_CONFIG] info pkgdatadir`/site
114+
fi
115+
AC_MSG_RESULT($GUILE_SITE)
116+
AC_SUBST(GUILE_SITE)
117+
])
118+
119+
# GUILE_CHECK -- evaluate Guile Scheme code and capture the return value
120+
#
121+
# Usage: GUILE_CHECK_RETVAL(var,check)
122+
#
123+
# @var{var} is a shell variable name to be set to the return value.
124+
# @var{check} is a Guile Scheme expression, evaluated with "$GUILE -c", and
125+
# returning either 0 or non-#f to indicate the check passed.
126+
# Non-0 number or #f indicates failure.
127+
# Avoid using the character "#" since that confuses autoconf.
128+
#
129+
AC_DEFUN([GUILE_CHECK],
130+
[AC_REQUIRE([GUILE_PROGS])
131+
$GUILE -c "$2" > /dev/null 2>&1
132+
$1=$?
133+
])
134+
135+
# GUILE_MODULE_CHECK -- check feature of a Guile Scheme module
136+
#
137+
# Usage: GUILE_MODULE_CHECK(var,module,featuretest,description)
138+
#
139+
# @var{var} is a shell variable name to be set to "yes" or "no".
140+
# @var{module} is a list of symbols, like: (ice-9 common-list).
141+
# @var{featuretest} is an expression acceptable to GUILE_CHECK, q.v.
142+
# @var{description} is a present-tense verb phrase (passed to AC_MSG_CHECKING).
143+
#
144+
AC_DEFUN([GUILE_MODULE_CHECK],
145+
[AC_MSG_CHECKING([if $2 $4])
146+
GUILE_CHECK($1,(use-modules $2) (exit ((lambda () $3))))
147+
if test "$$1" = "0" ; then $1=yes ; else $1=no ; fi
148+
AC_MSG_RESULT($$1)
149+
])
150+
151+
# GUILE_MODULE_AVAILABLE -- check availability of a Guile Scheme module
152+
#
153+
# Usage: GUILE_MODULE_AVAILABLE(var,module)
154+
#
155+
# @var{var} is a shell variable name to be set to "yes" or "no".
156+
# @var{module} is a list of symbols, like: (ice-9 common-list).
157+
#
158+
AC_DEFUN([GUILE_MODULE_AVAILABLE],
159+
[GUILE_MODULE_CHECK($1,$2,0,is available)
160+
])
161+
162+
# GUILE_MODULE_REQUIRED -- fail if a Guile Scheme module is unavailable
163+
#
164+
# Usage: GUILE_MODULE_REQUIRED(symlist)
165+
#
166+
# @var{symlist} is a list of symbols, WITHOUT surrounding parens,
167+
# like: ice-9 common-list.
168+
#
169+
AC_DEFUN([GUILE_MODULE_REQUIRED],
170+
[GUILE_MODULE_AVAILABLE(ac_guile_module_required, ($1))
171+
if test "$ac_guile_module_required" = "no" ; then
172+
AC_MSG_ERROR([required guile module not found: ($1)])
173+
fi
174+
])
175+
176+
# GUILE_MODULE_EXPORTS -- check if a module exports a variable
177+
#
178+
# Usage: GUILE_MODULE_EXPORTS(var,module,modvar)
179+
#
180+
# @var{var} is a shell variable to be set to "yes" or "no".
181+
# @var{module} is a list of symbols, like: (ice-9 common-list).
182+
# @var{modvar} is the Guile Scheme variable to check.
183+
#
184+
AC_DEFUN([GUILE_MODULE_EXPORTS],
185+
[GUILE_MODULE_CHECK($1,$2,$3,exports `$3')
186+
])
187+
188+
# GUILE_MODULE_REQUIRED_EXPORT -- fail if a module doesn't export a variable
189+
#
190+
# Usage: GUILE_MODULE_REQUIRED_EXPORT(module,modvar)
191+
#
192+
# @var{module} is a list of symbols, like: (ice-9 common-list).
193+
# @var{modvar} is the Guile Scheme variable to check.
194+
#
195+
AC_DEFUN([GUILE_MODULE_REQUIRED_EXPORT],
196+
[GUILE_MODULE_EXPORTS(guile_module_required_export,$1,$2)
197+
if test "$guile_module_required_export" = "no" ; then
198+
AC_MSG_ERROR([module $1 does not export $2; required])
199+
fi
200+
])
201+
202+
## guile.m4 ends here

‎configure.ac

+15-11
Original file line numberDiff line numberDiff line change
@@ -1,24 +1,28 @@
1-
AC_PREREQ ([2.50])
2-
AC_INIT([guile-irc], 0.2)
1+
dnl -*- Autoconf -*-
2+
3+
AC_INIT(guile-irc, 0.2)
4+
AC_CONFIG_SRCDIR(irc/irc.scm)
35
AC_CONFIG_AUX_DIR([build-aux])
4-
AC_CONFIG_SRCDIR([irc.scm])
6+
AM_INIT_AUTOMAKE([color-tests -Wall -Wno-portability foreign])
57
AM_SILENT_RULES([yes])
68

7-
AC_CONFIG_MACRO_DIR([m4])
9+
GUILE_PROGS
810

9-
AM_INIT_AUTOMAKE()
11+
if $GUILE_TOOLS | grep -q compile; then
12+
# everything cool
13+
true
14+
else
15+
AC_MSG_ERROR([Guile 2.0 required.])
16+
fi
1017

11-
GUILE_PROGS()
12-
GUILE_SITE_DIR()
18+
AC_CONFIG_FILES([Makefile irc/config.scm] [doc/Makefile])
19+
AC_CONFIG_FILES([env], [chmod +x env])
1320

14-
PKG_CHECK_MODULES([GUILE], [guile-2.0])
1521

1622
AC_CHECK_PROG(have_makeinfo, makeinfo, yes, no)
1723
AM_CONDITIONAL(HAVE_MAKEINFO, test "$have_makeinfo" = yes)
1824

1925
AC_CHECK_PROG(have_pdf, texi2pdf, yes, no)
2026
AM_CONDITIONAL(HAVE_PDF, test "$have_pdf" = yes)
2127

22-
AC_CONFIG_FILES([Makefile] [doc/Makefile])
23-
24-
AC_OUTPUT()
28+
AC_OUTPUT

‎env.in

+14
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,14 @@
1+
#!/bin/sh
2+
3+
GUILE_LOAD_PATH=@abs_top_srcdir@:$GUILE_LOAD_PATH
4+
if test "@abs_top_srcdir@" != "@abs_top_builddir@"; then
5+
GUILE_LOAD_PATH=@abs_top_builddir@:$GUILE_LOAD_PATH
6+
fi
7+
GUILE_LOAD_COMPILED_PATH=@abs_top_builddir@:$GUILE_LOAD_PATH
8+
PATH=@abs_top_builddir@/bin:$PATH
9+
10+
export GUILE_LOAD_PATH
11+
export GUILE_LOAD_COMPILED_PATH
12+
export PATH
13+
14+
exec "$@"

‎guile.am

+19
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,19 @@
1+
GOBJECTS = $(SOURCES:%.scm=%.go)
2+
3+
nobase_mod_DATA = $(SOURCES) $(NOCOMP_SOURCES)
4+
nobase_go_DATA = $(GOBJECTS)
5+
6+
7+
8+
9+
10+
11+
guile_install_go_files = install-nobase_goDATA
12+
$(guile_install_go_files): install-nobase_modDATA
13+
14+
CLEANFILES = $(GOBJECTS)
15+
EXTRA_DIST = $(SOURCES) $(NOCOMP_SOURCES)
16+
GUILE_WARNINGS = -Wunbound-variable -Warity-mismatch -Wformat
17+
SUFFIXES = .scm .go
18+
.scm.go:
19+
$(AM_V_GEN)$(top_builddir)/env $(GUILE_TOOLS) compile $(GUILE_WARNINGS) -o "$@" "$<"

‎irc/channel.scm

+43
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,43 @@
1+
;; Copyright (C) 2012 bas smit (fbs)
2+
;; Copyright (C) 2013 Andreas W (add^_)
3+
4+
5+
;; This program is free software; you can redistribute it and/or
6+
;; modify it under the terms of the GNU Lesser General Public License
7+
;; as published by the Free Software Foundation; either version 2
8+
;; of the License, or (at your option) any later version.
9+
10+
;; This program is distributed in the hope that it will be useful,
11+
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12+
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13+
;; GNU Lesser General Public License for more details.
14+
15+
;; You should have received a copy of the GNU Lesser General Public License
16+
;; along with this program; if not, write to the Free Software
17+
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
18+
19+
(define-module (irc channel)
20+
#:version (0 3 0)
21+
#:export (make-channel-table
22+
channel-add!
23+
channel-remove!
24+
channel-clear!
25+
channel-table->list
26+
channel-ref))
27+
28+
(define (make-channel-table)
29+
(make-hash-table 31))
30+
31+
(define (channel-add! table channel)
32+
(hash-set! table channel #t))
33+
34+
(define (channel-remove! table channel)
35+
(hash-remove! table channel))
36+
37+
(define channel-clear! hash-clear!)
38+
39+
(define (channel-table->list table)
40+
(hash-map->list (lambda (x y) x) table))
41+
42+
(define (channel-ref table channel)
43+
(hash-ref table channel))

‎irc/config.scm.in

+5
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,5 @@
1+
(define-module (irc config)
2+
#:export (abs-top-srcdir))
3+
4+
(define (abs-top-srcdir)
5+
"@abs_top_srcdir@")

‎error-code.scm ‎irc/error-code.scm

+2-1
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
;; Copyright (C) 2012 bas smit (fbs)
2+
;; Copyright (C) 2013 Andreas W (add^_)
23

34
;; This program is free software; you can redistribute it and/or
45
;; modify it under the terms of the GNU Lesser General Public License
@@ -15,7 +16,7 @@
1516
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
1617

1718
(define-module (irc error-code)
18-
#:version (0 2 1)
19+
#:version (0 3 0)
1920
#:export (lookup-error-code
2021
error-name
2122
error-description))

‎error.scm ‎irc/error.scm

+2-1
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
;; Copyright (C) 2012 bas smit (fbs)
2+
;; Copyright (C) 2013 Andreas W (add^_)
23

34
;; This program is free software; you can redistribute it and/or
45
;; modify it under the terms of the GNU Lesser General Public License
@@ -15,7 +16,7 @@
1516
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
1617

1718
(define-module (irc error)
18-
#:version (0 2 1)
19+
#:version (0 3 0)
1920
#:export (irc-error
2021
irc-type-error))
2122

‎handlers.scm ‎irc/handlers.scm

+2-1
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
;; Copyright (C) 2012 bas smit (fbs)
2+
;; Copyright (C) 2013 Andreas W (add^_)
23
;;
34
;; This program is free software; you can redistribute it and/or
45
;; modify it under the terms of the GNU Lesser General Public License
@@ -15,7 +16,7 @@
1516
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
1617

1718
(define-module (irc handlers)
18-
#:version (0 2 1)
19+
#:version (0 3 0)
1920
#:use-module (irc irc)
2021
#:use-module ((irc message)
2122
#:renamer (symbol-prefix-proc 'msg:))

‎irc.scm ‎irc/irc.scm

+83-21
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
;; Copyright (C) 2012 bas smit (fbs)
2+
;; Copyright (C) 2013 Andreas W (add^_)
23
;;
34
;; This program is free software; you can redistribute it and/or
45
;; modify it under the terms of the GNU Lesser General Public License
@@ -15,14 +16,17 @@
1516
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
1617

1718
(define-module (irc irc)
18-
#:version (0 2 1)
19+
#:version (0 3 0)
1920
#:use-module ((irc message)
2021
#:renamer (symbol-prefix-proc 'msg:))
22+
#:use-module ((gnutls)
23+
#:renamer (symbol-prefix-proc 'gnutls:))
2124
#:use-module (irc tagged-hook)
2225
#:use-module (irc channel)
2326
#:use-module (irc error)
2427
#:use-module (ice-9 format)
2528
#:use-module (ice-9 rdelim)
29+
#:use-module (ice-9 popen)
2630
#:export (add-message-hook!
2731
add-simple-message-hook!
2832
channels->list
@@ -58,17 +62,25 @@
5862
set-password!
5963
set-port!
6064
set-realname!
61-
set-server!))
62-
63-
;;;; Some constants
65+
set-server!
66+
67+
;; s-i/o ;; For debugging purposes
68+
;; session ;; For debugging purposes
69+
;; _socket ;; For debugging purposes
70+
;; tls? ;; For debugging purposes
71+
;; registered? ;; For debugging purposes
72+
73+
do-wrap-port/tls))
74+
75+
;;;; Some globals
6476
(define *nick* "bot")
6577
(define *realname* "mr bot")
6678
(define *server* "localhost")
6779
(define *port* 6667)
68-
(define *hostname* "localhost")
80+
(define *hostname* *server*)
6981
(define *quitmsg* "Not enough parenthesis")
7082

71-
(define *max-msgl* 510)
83+
(define *max-msgl* 500)
7284

7385
;;;; macros
7486

@@ -79,10 +91,14 @@
7991
;; Hostname: String irc hostname
8092
;; Nick: String irc nickname
8193
;; password: String #f irc password
82-
;; port: Number irc port
94+
;; port: Integer irc port
8395
;; realname: String irc realname
8496
;; server: String irc server url
8597
;; socket: Socket Socket
98+
;; session Session Session
99+
;; tls Boolean #t if on, otherwise #f
100+
;; registered Boolean #f if not registered
101+
;; s-i/o In/output Input/output session
86102

87103
(define irc-object
88104
(make-record-type
@@ -95,7 +111,11 @@
95111
port
96112
realname
97113
server
98-
socket)
114+
socket
115+
session
116+
tls
117+
registered
118+
s-i/o)
99119
(lambda (obj port)
100120
(format port "#<~A~c irc object>"
101121
((record-accessor irc-object 'server) obj)
@@ -107,6 +127,10 @@
107127
(define channels (record-accessor irc-object 'channels))
108128
(define hooks (record-accessor irc-object 'hooks))
109129
(define _socket (record-accessor irc-object 'socket))
130+
(define session (record-accessor irc-object 'session))
131+
(define s-i/o (record-accessor irc-object 's-i/o))
132+
(define tls? (record-accessor irc-object 'tls))
133+
(define registered? (record-accessor irc-object 'registered))
110134

111135
(define (symbolize c)
112136
"Symbolize returns a symbol if @var{c} is a symbol or string, #f otherwise."
@@ -153,17 +177,22 @@
153177
(define (send-raw obj str)
154178
"Send string @var{str} to the server"
155179
(let ([msg (string-append str "\r\n")])
156-
(send (_socket obj) msg)))
180+
(if (tls? obj)
181+
(display msg (s-i/o obj))
182+
(display msg (_socket obj)))))
157183

158184
(define (read-message obj)
159185
"Read a parsed message from irc-object obj."
160186
(define (delete-return s)
161-
(string-delete s (string->char-set "\r")))
162-
(let* ([s (_socket obj)]
163-
[m (and (char-ready? s) (read-line s))])
187+
(string-delete (string->char-set "\r") s))
188+
(let* ([i/o (s-i/o obj)]
189+
[soc (_socket obj)]
190+
[message (and (char-ready? soc) (if (registered? obj)
191+
(read-line i/o)
192+
(read-line soc)))])
164193
(cond
165-
((eof-object? m) #f)
166-
(m (msg:parse-message-string (delete-return m)))
194+
((eof-object? message) #f)
195+
(message (msg:parse-message-string (delete-return message)))
167196
(else #f))))
168197

169198
(define* (cleanup-irc-object obj)
@@ -173,7 +202,11 @@ to #f to disable."
173202
(channel-clear! (channels obj))
174203
((record-modifier irc-object 'connected) obj #f)
175204
(and (_socket obj) (close-port (_socket obj)))
176-
((record-modifier irc-object 'socket) obj #f))
205+
((record-modifier irc-object 'socket) obj #f)
206+
((record-modifier irc-object 'registered) obj #f)
207+
((record-modifier irc-object 'session) obj #f)
208+
((record-modifier irc-object 's-i/o) obj #f)
209+
((record-modifier irc-object 'tls) obj #f))
177210

178211
(define (irc-object? obj)
179212
((record-predicate irc-object) obj))
@@ -203,7 +236,10 @@ hostname: string."
203236
realname ;; realname
204237
server ;; server
205238
#f ;; socket
206-
))
239+
#f ;; session
240+
#f ;; tls
241+
#f ;; registered
242+
#f)) ;; secure i/o
207243

208244
(define (channels->list obj)
209245
"Return the channels joined by irc-object @var{obj} as list."
@@ -273,9 +309,9 @@ returns #f, else #t."
273309
(addrinfo:socktype ai)
274310
(addrinfo:protocol ai))])
275311
(connect s
276-
(addrinfo:fam ai)
277-
(sockaddr:addr (addrinfo:addr ai))
278-
(port ircobj))
312+
(addrinfo:fam ai)
313+
(sockaddr:addr (addrinfo:addr ai))
314+
(port ircobj))
279315
((record-modifier irc-object 'socket) ircobj s)
280316
((record-modifier irc-object 'connected) ircobj #t)))
281317

@@ -307,10 +343,12 @@ returns #f, else #t."
307343
#:middle (format #f "~a ~a *" (nick obj) (hostname obj))
308344
#:trailing (realname obj)))
309345

310-
(if (not (connected? obj))
346+
(when (not (connected? obj))
311347
(do-connect obj))
312348
((record-modifier irc-object 'nick) obj (try-nick (nick obj)))
313-
(try-user))
349+
(try-user)
350+
(when (not (registered? obj))
351+
((record-modifier irc-object 'registered) obj #t)))
314352

315353
(define* (do-close obj)
316354
"Close the connection without sending QUIT."
@@ -422,3 +460,27 @@ Procedures will be added to the front of the hook unless append is not #f."
422460
(reset-tagged-hook! (hooks obj)))
423461

424462
(define handle-message run-message-hook)
463+
464+
(define (tls-wrap port session)
465+
"Return PORT wrapped in a TLS connection."
466+
(define (log level str)
467+
(format (current-error-port)
468+
"gnutls: [~a|~a] ~a" (getpid) level str))
469+
(gnutls:set-session-transport-fd! session (fileno port))
470+
;;(gnutls:set-session-transport-port! session port)
471+
(gnutls:set-session-default-priority! session)
472+
(gnutls:set-session-credentials! session (gnutls:make-certificate-credentials))
473+
;; Uncomment the following lines in case of debugging
474+
;; emergency.
475+
;;(gnutls:set-log-level! 10)
476+
;;(gnutls:set-log-procedure! log)
477+
(gnutls:handshake session)
478+
(gnutls:session-record-port session))
479+
480+
(define (do-wrap-port/tls obj)
481+
(let* ([session (gnutls:make-session gnutls:connection-end/client)]
482+
[s-i/o (tls-wrap (_socket obj) session)])
483+
((record-modifier irc-object 'tls) obj #t)
484+
((record-modifier irc-object 'session) obj session)
485+
((record-modifier irc-object 's-i/o) obj s-i/o)))
486+

‎message.scm ‎irc/message.scm

+2-1
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
;; Copyright (C) 2012 bas smit (fbs)
2+
;; Copyright (C) 2013 Andreas W (add^_)
23

34
;; This program is free software; you can redistribute it and/or
45
;; modify it under the terms of the GNU Lesser General Public License
@@ -23,7 +24,7 @@
2324
;;;;;;;;;;;
2425

2526
(define-module (irc message)
26-
#:version (0 2 1)
27+
#:version (0 3 0)
2728
#:use-module (ice-9 regex)
2829
#:use-module (ice-9 format)
2930
#:use-module (ice-9 rdelim)

‎tagged-hook.scm ‎irc/tagged-hook.scm

+2-1
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
;; Copyright (C) 2012 bas smit (fbs)
2+
;; Copyright (C) 2013 Andreas W (add^_)
23

34
;; This program is free software; you can redistribute it and/or
45
;; modify it under the terms of the GNU Lesser General Public License
@@ -15,7 +16,7 @@
1516
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
1617

1718
(define-module (irc tagged-hook)
18-
#:version (0 2 1)
19+
#:version (0 3 0)
1920
#:use-module (irc error)
2021
#:export (make-tagged-hook
2122
tagged-hook?

0 commit comments

Comments
 (0)
This repository has been archived.