sockets/namedb/services.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Indent-tabs-mode: NIL -*-
   2 ;;;
   3 ;;; services.lisp --- Service lookup.
   4 ;;;
   5 ;;; Copyright (C) 2006-2007, Stelian Ionescu  <sionescu@common-lisp.net>
   6 ;;;
   7 ;;; This code is free software; you can redistribute it and/or
   8 ;;; modify it under the terms of the version 2.1 of
   9 ;;; the GNU Lesser General Public License as published by
  10 ;;; the Free Software Foundation, as clarified by the
  11 ;;; preamble found here:
  12 ;;;     http://opensource.franz.com/preamble.html
  13 ;;;
  14 ;;; This program is distributed in the hope that it will be useful,
  15 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;;; GNU General Public License for more details.
  18 ;;;
  19 ;;; You should have received a copy of the GNU Lesser General
  20 ;;; Public License along with this library; if not, write to the
  21 ;;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
  22 ;;; Boston, MA 02110-1301, USA
  23
  24 (in-package :net.sockets)
  25
  26 (defclass service ()
  27   ((name :initarg :name :reader service-name
  28          :documentation "The service name.")
  29    (port :initarg :port :reader service-port
  30           :documentation "The service's default port.")
  31    ;; why only these keyword? --luis
  32    (protocol :initarg :protocol :reader service-protocol
  33              :documentation "The service's protocol, :TCP or :UDP."))
  34   (:documentation "Class representing a service."))
  35
  36 (defun make-service (name port protocol)
  37   "Constructor for SERVICE objects."
  38   (make-instance 'service :name name :port port :protocol protocol))
  39
  40 (defmethod print-object ((service service) stream)
  41   (print-unreadable-object (service stream :type t :identity nil)
  42     (with-slots (name port protocol) service
  43       (format stream "Name: ~A Port: ~A Protocol: ~A" name port protocol))))
  44
  45 (defun lookup-service-number (service protocol))
  46
  47 (defun lookup-service-name (service protocol))
  48
  49 (define-condition unknown-service ()
  50   ((name :initarg :name :initform nil :reader service-name))
  51   (:report (lambda (condition stream)
  52              (format stream "Unknown service: ~S" (service-name condition))))
  53   (:documentation "Condition raised when a network service is not found."))
  54
  55 (defun lookup-service (service &optional (protocol :tcp))
  56   "Lookup a service by port or name.  PROTOCOL should be one
  57 of :TCP, :UDP or :ANY."
  58   (check-type protocol (member :tcp :udp :any))
  59   (let* ((parsed-number (parse-number-or-nil service :ub16))
  60          (serv (if parsed-number
  61                    (lookup-service-number parsed-number protocol)
  62                    (lookup-service-name service protocol))))
  63
  64     (or serv (error 'unknown-service :name service))))