~ubuntu-branches/ubuntu/intrepid/ecl/intrepid

« back to all changes in this revision

Viewing changes to contrib/sockets/sockets.lisp

• browse files at revision 6
• compare with another revision
• download diff
• download tarball
• view history from revision 6

Show diffs side-by-side

added

removed

contrib/sockets/sockets.lisp

1

1

;; -*- Mode: Lisp; Syntax: Common-Lisp -*-

2

 

;; $Id: sockets.lisp,v 1.26 2006/06/26 07:33:35 jgarcia Exp $

 

2

;; $Id: sockets.lisp,v 1.30 2007/03/24 11:19:41 jgarcia Exp $

3

3

 

4

4

;; This file is based on SBCL's SB-BSD-SOCKET module and has been

5

5

;; heavily modified to work with ECL by Julian Stecklina.

185

185

                int length = hostent->h_length;

186

186

 

187

187

                funcall(3,#2,make_simple_base_string(hostent->h_name),#1);

188

 

                funcall(3,#4,make_integer(hostent->h_addrtype),#1);

 

188

                funcall(3,#4,ecl_make_integer(hostent->h_addrtype),#1);

189

189

 

190

190

                for (aliases = hostent->h_aliases; *aliases != NULL; aliases++) {

191

191

                        aliases_list = CONS(make_simple_base_string(*aliases),aliases_list);

196

196

                        int pos;

197

197

                        cl_object vector = funcall(2,@make-array,MAKE_FIXNUM(length));

198

198

                        for (pos = 0; pos < length; pos++)

199

 

                                aset(vector, pos, MAKE_FIXNUM((unsigned char)((*addrs)[pos])));

 

199

                                ecl_aset(vector, pos, MAKE_FIXNUM((unsigned char)((*addrs)[pos])));

200

200

                        addr_list = CONS(vector, addr_list);

201

201

 

202

202

 

225

225

               (t t t t t t) t

226

226

               "

227

227

{

228

 

        unsigned char vector[4] = { fixint(aref(#0,0)),

229

 

                                    fixint(aref(#0,1)),

230

 

                                    fixint(aref(#0,2)),

231

 

                                    fixint(aref(#0,3)) };

232

 

        struct hostent *hostent = gethostbyaddr(vector,4,AF_INET);

 

228

        unsigned char vector[4];

 

229

        struct hostent *hostent;

 

230

        vector[0] = fixint(ecl_aref(#0,0));

 

231

        vector[1] = fixint(ecl_aref(#0,1));

 

232

        vector[2] = fixint(ecl_aref(#0,2));

 

233

        vector[3] = fixint(ecl_aref(#0,3));

 

234

        hostent = gethostbyaddr(vector,4,AF_INET);

233

235

 

234

236

        if (hostent != NULL) {

235

237

                char **aliases;

239

241

                int length = hostent->h_length;

240

242

 

241

243

                funcall(3,#2,make_simple_base_string(hostent->h_name),#1);

242

 

                funcall(3,#4,make_integer(hostent->h_addrtype),#1);

 

244

                funcall(3,#4,ecl_make_integer(hostent->h_addrtype),#1);

243

245

 

244

246

                for (aliases = hostent->h_aliases; *aliases != NULL; aliases++) {

245

247

                        aliases_list = CONS(make_simple_base_string(*aliases),aliases_list);

250

252

                        int pos;

251

253

                        cl_object vector = funcall(2,@make-array,MAKE_FIXNUM(length));

252

254

                        for (pos = 0; pos < length; pos++)

253

 

                                aset(vector, pos, MAKE_FIXNUM((unsigned char)((*addrs)[pos])));

 

255

                                ecl_aset(vector, pos, MAKE_FIXNUM((unsigned char)((*addrs)[pos])));

254

256

                        addr_list = CONS(vector, addr_list);

255

257

 

256

258

 

437

439

        if (t == t_base_string) {

438

440

                ok = (size < x->base_string.dim);

439

441

        } else if (t == t_vector) {

440

 

                cl_elttype aet = x->vector.elttype;

 

442

                cl_elttype aet = (cl_elttype)x->vector.elttype;

441

443

                if (aet == aet_b8 || aet == aet_i8 || aet == aet_bc) {

442

444

                        ok = (size < x->vector.dim);

443

445

                } else if (aet == aet_fix || aet == aet_index) {

566

568

      (c-inline (sfd) (:int) (values :int :object)

567

569

"{

568

570

        struct sockaddr_in sockaddr;

569

 

        int addr_len = sizeof(struct sockaddr_in);

 

571

        socklen_t addr_len = (socklen_t)sizeof(struct sockaddr_in);

570

572

        int new_fd = accept(#0, (struct sockaddr*)&sockaddr, &addr_len);

571

573

 

572

574

        @(return 0) = new_fd;

576

578

                uint16_t port = ntohs(sockaddr.sin_port);

577

579

                cl_object vector = cl_make_array(1,MAKE_FIXNUM(4));

578

580

 

579

 

                aset(vector,0, MAKE_FIXNUM( ip>>24 ));

580

 

                aset(vector,1, MAKE_FIXNUM( (ip>>16) & 0xFF));

581

 

                aset(vector,2, MAKE_FIXNUM( (ip>>8) & 0xFF));

582

 

                aset(vector,3, MAKE_FIXNUM( ip & 0xFF ));

 

581

                ecl_aset(vector,0, MAKE_FIXNUM( ip>>24 ));

 

582

                ecl_aset(vector,1, MAKE_FIXNUM( (ip>>16) & 0xFF));

 

583

                ecl_aset(vector,2, MAKE_FIXNUM( (ip>>8) & 0xFF));

 

584

                ecl_aset(vector,3, MAKE_FIXNUM( ip & 0xFF ));

583

585

 

584

586

                @(return 1) = vector;

585

587

        }

625

627

                uint32_t ip = ntohl(name.sin_addr.s_addr);

626

628

                uint16_t port = ntohs(name.sin_port);

627

629

 

628

 

                aset(#1,0, MAKE_FIXNUM( ip>>24 ));

629

 

                aset(#1,1, MAKE_FIXNUM( (ip>>16) & 0xFF));

630

 

                aset(#1,2, MAKE_FIXNUM( (ip>>8) & 0xFF));

631

 

                aset(#1,3, MAKE_FIXNUM( ip & 0xFF ));

 

630

                ecl_aset(#1,0, MAKE_FIXNUM( ip>>24 ));

 

631

                ecl_aset(#1,1, MAKE_FIXNUM( (ip>>16) & 0xFF));

 

632

                ecl_aset(#1,2, MAKE_FIXNUM( (ip>>8) & 0xFF));

 

633

                ecl_aset(#1,3, MAKE_FIXNUM( ip & 0xFF ));

632

634

 

633

635

                @(return) = port;

634

636

         } else {

652

654

                uint32_t ip = ntohl(name.sin_addr.s_addr);

653

655

                uint16_t port = ntohs(name.sin_port);

654

656

 

655

 

                aset(#1,0, MAKE_FIXNUM( ip>>24 ));

656

 

                aset(#1,1, MAKE_FIXNUM( (ip>>16) & 0xFF));

657

 

                aset(#1,2, MAKE_FIXNUM( (ip>>8) & 0xFF));

658

 

                aset(#1,3, MAKE_FIXNUM( ip & 0xFF ));

 

657

                ecl_aset(#1,0, MAKE_FIXNUM( ip>>24 ));

 

658

                ecl_aset(#1,1, MAKE_FIXNUM( (ip>>16) & 0xFF));

 

659

                ecl_aset(#1,2, MAKE_FIXNUM( (ip>>8) & 0xFF));

 

660

                ecl_aset(#1,3, MAKE_FIXNUM( ip & 0xFF ));

659

661

 

660

662

                @(return) = port;

661

663

         } else {

769

771

        sockaddr.sun_len = sizeof(struct sockaddr_un);

770

772

#endif

771

773

        sockaddr.sun_family = #2;

772

 

        strncpy(&sockaddr.sun_path,#1,sizeof(sockaddr.sun_path));

 

774

        strncpy(sockaddr.sun_path,#1,sizeof(sockaddr.sun_path));

773

775

        sockaddr.sun_path[sizeof(sockaddr.sun_path)-1] = '\0';

774

776

 

775

 

        @(return) = bind(#0,&sockaddr, sizeof(struct sockaddr_un));

 

777

        @(return) = bind(#0,(struct sockaddr*)&sockaddr, sizeof(struct sockaddr_un));

776

778

}"))

777

779

        (socket-error "bind"))))

778

780

 

781

783

      (c-inline ((socket-file-descriptor socket)) (:int) (values :int :object)

782

784

"{

783

785

        struct sockaddr_un sockaddr;

784

 

        int addr_len = sizeof(struct sockaddr_un);

785

 

        int new_fd = accept(#0, &sockaddr, &addr_len);

 

786

        socklen_t addr_len = (socklen_t)sizeof(struct sockaddr_un);

 

787

        int new_fd = accept(#0, (struct sockaddr *)&sockaddr, &addr_len);

786

788

        @(return 0) = new_fd;

787

 

        @(return 1) = (new_fd == -1) ? Cnil : make_base_string_copy(&sockaddr.sun_path);

 

789

        @(return 1) = (new_fd == -1) ? Cnil : make_base_string_copy(sockaddr.sun_path);

788

790

}")

789

791

    (cond

790

792

      ((= fd -1)

812

814

        sockaddr.sun_len = sizeof(struct sockaddr_un);

813

815

#endif

814

816

        sockaddr.sun_family = #1;

815

 

        strncpy(&sockaddr.sun_path,#2,sizeof(sockaddr.sun_path));

 

817

        strncpy(sockaddr.sun_path,#2,sizeof(sockaddr.sun_path));

816

818

        sockaddr.sun_path[sizeof(sockaddr.sun_path)-1] = '\0';

817

819

 

818

 

        @(return) = connect(#0,&sockaddr, sizeof(struct sockaddr_un));

 

820

        @(return) = connect(#0,(struct sockaddr*)&sockaddr, sizeof(struct sockaddr_un));

819

821

}"))

820

822

        (socket-error "connect"))))

821

823

 

826

828

{

827

829

        struct sockaddr_un name;

828

830

        socklen_t len = sizeof(struct sockaddr_un);

829

 

        int ret = getpeername(#0,&name,&len);

 

831

        int ret = getpeername(#0,(struct sockaddr*)&name,&len);

830

832

 

831

833

        if (ret == 0) {

832

 

                @(return) = make_base_string_copy(&name.sun_path);

 

834

                @(return) = make_base_string_copy(name.sun_path);

833

835

        } else {

834

836

                @(return) = Cnil;

835

837

        }

1104

1106

                  buffering)

1105

1107

            (t :int :int :object)

1106

1108

            t

1107

 

            "si_set_buffering_mode(ecl_make_stream_from_fd(#0,#1,#2), #3)"

 

1109

            "si_set_buffering_mode(ecl_make_stream_from_fd(#0,#1,(enum ecl_smmode)#2), #3)"

1108

1110

            :one-liner t))

1109

1111

 

1110

1112

(defmethod socket-make-stream ((socket socket)  &rest args &key (buffering-mode NIL))

1293

1295

  (setf *name-service-errno* (c-constant #-:wsock "h_errno" #+:wsock "WSAGetLastError()")))

1294

1296

 

1295

1297

(defun get-name-service-error-message (num)

1296

 

  #-:wsock

1297

 

  (c-inline (num) (:int) :cstring "hstrerror(#0)" :one-liner t)

 

1298

  #+:nsr

 

1299

  (c-inline (num) (:int) :cstring "strerror(#0)" :one-liner t)

1298

1300

  #+:wsock

1299

1301

  (get-win32-error-string num)

 

1302

  #-(or :wsock :nsr)

 

1303

  (c-inline (num) (:int) :cstring "strerror(#0)" :one-liner t)

1300

1304

)

1301

1305

 

1302

1306

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

1311

1315

        socklen_t socklen = sizeof(int);

1312

1316

        int ret = getsockopt(#0,SOL_SOCKET,#1,&sockopt,&socklen);

1313

1317

 

1314

 

        @(return) = (ret == 0) ? make_integer(sockopt) : Cnil;

 

1318

        @(return) = (ret == 0) ? ecl_make_integer(sockopt) : Cnil;

1315

1319

}")))

1316

1320

    (if ret

1317

1321

        ret

• Older »

Loggerhead is a web-based interface for Breezy
Version: 2.0.1