1;;; net-utils.el --- network functions 2 3;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 4;; 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Peter Breton <pbreton@cs.umb.edu> 7;; Created: Sun Mar 16 1997 8;; Keywords: network comm 9 10;; This file is part of GNU Emacs. 11 12;; GNU Emacs is free software; you can redistribute it and/or modify 13;; it under the terms of the GNU General Public License as published by 14;; the Free Software Foundation; either version 2, or (at your option) 15;; any later version. 16 17;; GNU Emacs is distributed in the hope that it will be useful, 18;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20;; GNU General Public License for more details. 21 22;; You should have received a copy of the GNU General Public License 23;; along with GNU Emacs; see the file COPYING. If not, write to the 24;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 25;; Boston, MA 02110-1301, USA. 26 27;;; Commentary: 28 29;; 30;; There are three main areas of functionality: 31;; 32;; * Wrap common network utility programs (ping, traceroute, netstat, 33;; nslookup, arp, route). Note that these wrappers are of the diagnostic 34;; functions of these programs only. 35;; 36;; * Implement some very basic protocols in Emacs Lisp (finger and whois) 37;; 38;; * Support connections to HOST/PORT, generally for debugging and the like. 39;; In other words, for doing much the same thing as "telnet HOST PORT", and 40;; then typing commands. 41;; 42;; PATHS 43;; 44;; On some systems, some of these programs are not in normal user path, 45;; but rather in /sbin, /usr/sbin, and so on. 46 47 48;;; Code: 49(eval-when-compile 50 (require 'comint)) 51 52;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 53;; Customization Variables 54;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 55 56(defgroup net-utils nil 57 "Network utility functions." 58 :prefix "net-utils-" 59 :group 'comm 60 :version "20.3") 61 62(defcustom net-utils-remove-ctl-m 63 (member system-type (list 'windows-nt 'msdos)) 64 "If non-nil, remove control-Ms from output." 65 :group 'net-utils 66 :type 'boolean) 67 68(defcustom traceroute-program 69 (if (eq system-type 'windows-nt) 70 "tracert" 71 "traceroute") 72 "Program to trace network hops to a destination." 73 :group 'net-utils 74 :type 'string) 75 76(defcustom traceroute-program-options nil 77 "Options for the traceroute program." 78 :group 'net-utils 79 :type '(repeat string)) 80 81(defcustom ping-program "ping" 82 "Program to send network test packets to a host." 83 :group 'net-utils 84 :type 'string) 85 86;; On GNU/Linux and Irix, the system's ping program seems to send packets 87;; indefinitely unless told otherwise 88(defcustom ping-program-options 89 (and (memq system-type (list 'linux 'gnu/linux 'irix)) 90 (list "-c" "4")) 91 "Options for the ping program. 92These options can be used to limit how many ICMP packets are emitted." 93 :group 'net-utils 94 :type '(repeat string)) 95 96(defcustom ipconfig-program 97 (if (eq system-type 'windows-nt) 98 "ipconfig" 99 "ifconfig") 100 "Program to print network configuration information." 101 :group 'net-utils 102 :type 'string) 103 104(defcustom ipconfig-program-options 105 (list 106 (if (eq system-type 'windows-nt) 107 "/all" "-a")) 108 "Options for ipconfig-program." 109 :group 'net-utils 110 :type '(repeat string)) 111 112(defcustom netstat-program "netstat" 113 "Program to print network statistics." 114 :group 'net-utils 115 :type 'string) 116 117(defcustom netstat-program-options 118 (list "-a") 119 "Options for netstat-program." 120 :group 'net-utils 121 :type '(repeat string)) 122 123(defcustom arp-program "arp" 124 "Program to print IP to address translation tables." 125 :group 'net-utils 126 :type 'string) 127 128(defcustom arp-program-options 129 (list "-a") 130 "Options for arp-program." 131 :group 'net-utils 132 :type '(repeat string)) 133 134(defcustom route-program 135 (if (eq system-type 'windows-nt) 136 "route" 137 "netstat") 138 "Program to print routing tables." 139 :group 'net-utils 140 :type 'string) 141 142(defcustom route-program-options 143 (if (eq system-type 'windows-nt) 144 (list "print") 145 (list "-r")) 146 "Options for route-program." 147 :group 'net-utils 148 :type '(repeat string)) 149 150(defcustom nslookup-program "nslookup" 151 "Program to interactively query DNS information." 152 :group 'net-utils 153 :type 'string) 154 155(defcustom nslookup-program-options nil 156 "List of options to pass to the nslookup program." 157 :group 'net-utils 158 :type '(repeat string)) 159 160(defcustom nslookup-prompt-regexp "^> " 161 "Regexp to match the nslookup prompt. 162 163This variable is only used if the variable 164`comint-use-prompt-regexp' is non-nil." 165 :group 'net-utils 166 :type 'regexp) 167 168(defcustom dig-program "dig" 169 "Program to query DNS information." 170 :group 'net-utils 171 :type 'string) 172 173(defcustom ftp-program "ftp" 174 "Progam to run to do FTP transfers." 175 :group 'net-utils 176 :type 'string) 177 178(defcustom ftp-program-options nil 179 "List of options to pass to the FTP program." 180 :group 'net-utils 181 :type '(repeat string)) 182 183(defcustom ftp-prompt-regexp "^ftp>" 184 "Regexp which matches the FTP program's prompt. 185 186This variable is only used if the variable 187`comint-use-prompt-regexp' is non-nil." 188 :group 'net-utils 189 :type 'regexp) 190 191(defcustom smbclient-program "smbclient" 192 "Smbclient program." 193 :group 'net-utils 194 :type 'string) 195 196(defcustom smbclient-program-options nil 197 "List of options to pass to the smbclient program." 198 :group 'net-utils 199 :type '(repeat string)) 200 201(defcustom smbclient-prompt-regexp "^smb: \>" 202 "Regexp which matches the smbclient program's prompt. 203 204This variable is only used if the variable 205`comint-use-prompt-regexp' is non-nil." 206 :group 'net-utils 207 :type 'regexp) 208 209(defcustom dns-lookup-program "host" 210 "Program to interactively query DNS information." 211 :group 'net-utils 212 :type 'string 213 ) 214 215(defcustom dns-lookup-program-options nil 216 "List of options to pass to the dns-lookup program." 217 :group 'net-utils 218 :type '(repeat string) 219 ) 220 221;; Internal variables 222(defvar network-connection-service nil) 223(defvar network-connection-host nil) 224 225;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 226;; Nslookup goodies 227;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 228 229(defconst nslookup-font-lock-keywords 230 (progn 231 (defvar font-lock-type-face) 232 (defvar font-lock-keyword-face) 233 (defvar font-lock-variable-name-face) 234 (require 'font-lock) 235 (list 236 (list "^[A-Za-z0-9 _]+:" 0 font-lock-type-face) 237 (list "\\<\\(SOA\\|NS\\|MX\\|A\\|CNAME\\)\\>" 238 1 font-lock-keyword-face) 239 ;; Dotted quads 240 (list 241 (mapconcat 'identity 242 (make-list 4 "[0-9]+") 243 "\\.") 244 0 font-lock-variable-name-face) 245 ;; Host names 246 (list 247 (let ((host-expression "[-A-Za-z0-9]+")) 248 (concat 249 (mapconcat 'identity 250 (make-list 2 host-expression) 251 "\\.") 252 "\\(\\." host-expression "\\)*")) 253 0 font-lock-variable-name-face))) 254 "Expressions to font-lock for nslookup.") 255 256;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 257;; Utility functions 258;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 259 260;; Simplified versions of some at-point functions from ffap.el. 261;; It's not worth loading all of ffap just for these. 262(defun net-utils-machine-at-point () 263 (let ((pt (point))) 264 (buffer-substring-no-properties 265 (save-excursion 266 (skip-chars-backward "-a-zA-Z0-9.") 267 (point)) 268 (save-excursion 269 (skip-chars-forward "-a-zA-Z0-9.") 270 (skip-chars-backward "." pt) 271 (point))))) 272 273(defun net-utils-url-at-point () 274 (let ((pt (point))) 275 (buffer-substring-no-properties 276 (save-excursion 277 (skip-chars-backward "--:=&?$+@-Z_a-z~#,%") 278 (skip-chars-forward "^A-Za-z0-9" pt) 279 (point)) 280 (save-excursion 281 (skip-chars-forward "--:=&?$+@-Z_a-z~#,%") 282 (skip-chars-backward ":;.,!?" pt) 283 (point))))) 284 285 286(defun net-utils-remove-ctrl-m-filter (process output-string) 287 "Remove trailing control Ms." 288 (let ((old-buffer (current-buffer)) 289 (filtered-string output-string)) 290 (unwind-protect 291 (let ((moving)) 292 (set-buffer (process-buffer process)) 293 (setq moving (= (point) (process-mark process))) 294 295 (while (string-match "\r" filtered-string) 296 (setq filtered-string 297 (replace-match "" nil nil filtered-string))) 298 299 (save-excursion 300 ;; Insert the text, moving the process-marker. 301 (goto-char (process-mark process)) 302 (insert filtered-string) 303 (set-marker (process-mark process) (point))) 304 (if moving (goto-char (process-mark process)))) 305 (set-buffer old-buffer)))) 306 307(defmacro net-utils-run-program (name header program &rest args) 308 "Run a network information program." 309 ` (let ((buf (get-buffer-create (concat "*" ,name "*")))) 310 (set-buffer buf) 311 (erase-buffer) 312 (insert ,header "\n") 313 (set-process-filter 314 (apply 'start-process ,name buf ,program ,@args) 315 'net-utils-remove-ctrl-m-filter) 316 (display-buffer buf) 317 buf)) 318 319;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 320;; Wrappers for external network programs 321;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 322 323;;;###autoload 324(defun traceroute (target) 325 "Run traceroute program for TARGET." 326 (interactive "sTarget: ") 327 (let ((options 328 (if traceroute-program-options 329 (append traceroute-program-options (list target)) 330 (list target)))) 331 (net-utils-run-program 332 (concat "Traceroute" " " target) 333 (concat "** Traceroute ** " traceroute-program " ** " target) 334 traceroute-program 335 options))) 336 337;;;###autoload 338(defun ping (host) 339 "Ping HOST. 340If your system's ping continues until interrupted, you can try setting 341`ping-program-options'." 342 (interactive 343 (list (read-from-minibuffer "Ping host: " (net-utils-machine-at-point)))) 344 (let ((options 345 (if ping-program-options 346 (append ping-program-options (list host)) 347 (list host)))) 348 (net-utils-run-program 349 (concat "Ping" " " host) 350 (concat "** Ping ** " ping-program " ** " host) 351 ping-program 352 options))) 353 354;;;###autoload 355(defun ipconfig () 356 "Run ipconfig program." 357 (interactive) 358 (net-utils-run-program 359 "Ipconfig" 360 (concat "** Ipconfig ** " ipconfig-program " ** ") 361 ipconfig-program 362 ipconfig-program-options)) 363 364;; This is the normal name on most Unixes. 365;;;###autoload 366(defalias 'ifconfig 'ipconfig) 367 368;;;###autoload 369(defun netstat () 370 "Run netstat program." 371 (interactive) 372 (net-utils-run-program 373 "Netstat" 374 (concat "** Netstat ** " netstat-program " ** ") 375 netstat-program 376 netstat-program-options)) 377 378;;;###autoload 379(defun arp () 380 "Run the arp program." 381 (interactive) 382 (net-utils-run-program 383 "Arp" 384 (concat "** Arp ** " arp-program " ** ") 385 arp-program 386 arp-program-options)) 387 388;;;###autoload 389(defun route () 390 "Run the route program." 391 (interactive) 392 (net-utils-run-program 393 "Route" 394 (concat "** Route ** " route-program " ** ") 395 route-program 396 route-program-options)) 397 398;; FIXME -- Needs to be a process filter 399;; (defun netstat-with-filter (filter) 400;; "Run netstat program." 401;; (interactive "sFilter: ") 402;; (netstat) 403;; (set-buffer (get-buffer "*Netstat*")) 404;; (goto-char (point-min)) 405;; (delete-matching-lines filter)) 406 407;;;###autoload 408(defun nslookup-host (host) 409 "Lookup the DNS information for HOST." 410 (interactive 411 (list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point)))) 412 (let ((options 413 (if nslookup-program-options 414 (append nslookup-program-options (list host)) 415 (list host)))) 416 (net-utils-run-program 417 "Nslookup" 418 (concat "** " 419 (mapconcat 'identity 420 (list "Nslookup" host nslookup-program) 421 " ** ")) 422 nslookup-program 423 options))) 424 425;;;###autoload 426(defun nslookup () 427 "Run nslookup program." 428 (interactive) 429 (require 'comint) 430 (comint-run nslookup-program) 431 (nslookup-mode)) 432 433;; Using a derived mode gives us keymaps, hooks, etc. 434(define-derived-mode nslookup-mode comint-mode "Nslookup" 435 "Major mode for interacting with the nslookup program." 436 (set 437 (make-local-variable 'font-lock-defaults) 438 '((nslookup-font-lock-keywords))) 439 (setq comint-prompt-regexp nslookup-prompt-regexp) 440 (setq comint-input-autoexpand t)) 441 442(define-key nslookup-mode-map "\t" 'comint-dynamic-complete) 443 444;;;###autoload 445(defun dns-lookup-host (host) 446 "Lookup the DNS information for HOST (name or IP address)." 447 (interactive 448 (list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point)))) 449 (let ((options 450 (if dns-lookup-program-options 451 (append dns-lookup-program-options (list host)) 452 (list host)))) 453 (net-utils-run-program 454 (concat "DNS Lookup [" host "]") 455 (concat "** " 456 (mapconcat 'identity 457 (list "DNS Lookup" host dns-lookup-program) 458 " ** ")) 459 dns-lookup-program 460 options 461 ))) 462 463;;;###autoload 464(defun run-dig (host) 465 "Run dig program." 466 (interactive 467 (list 468 (progn 469 (require 'ffap) 470 (read-from-minibuffer 471 "Lookup host: " 472 (with-no-warnings 473 (or (ffap-string-at-point 'machine) "")))))) 474 (net-utils-run-program 475 "Dig" 476 (concat "** " 477 (mapconcat 'identity 478 (list "Dig" host dig-program) 479 " ** ")) 480 dig-program 481 (list host))) 482 483;; This is a lot less than ange-ftp, but much simpler. 484;;;###autoload 485(defun ftp (host) 486 "Run ftp program." 487 (interactive 488 (list 489 (read-from-minibuffer 490 "Ftp to Host: " (net-utils-machine-at-point)))) 491 (require 'comint) 492 (let ((buf (get-buffer-create (concat "*ftp [" host "]*")))) 493 (set-buffer buf) 494 (ftp-mode) 495 (comint-exec buf (concat "ftp-" host) ftp-program nil 496 (if ftp-program-options 497 (append (list host) ftp-program-options) 498 (list host))) 499 (pop-to-buffer buf))) 500 501(define-derived-mode ftp-mode comint-mode "FTP" 502 "Major mode for interacting with the ftp program." 503 (setq comint-prompt-regexp ftp-prompt-regexp) 504 (setq comint-input-autoexpand t) 505 ;; Only add the password-prompting hook if it's not already in the 506 ;; global hook list. This stands a small chance of losing, if it's 507 ;; later removed from the global list (very small, since any 508 ;; password prompts will probably immediately follow the initial 509 ;; connection), but it's better than getting prompted twice for the 510 ;; same password. 511 (unless (memq 'comint-watch-for-password-prompt 512 (default-value 'comint-output-filter-functions)) 513 (add-hook 'comint-output-filter-functions 'comint-watch-for-password-prompt 514 nil t))) 515 516;; Occasionally useful 517(define-key ftp-mode-map "\t" 'comint-dynamic-complete) 518 519(defun smbclient (host service) 520 "Connect to SERVICE on HOST via SMB." 521 (interactive 522 (list 523 (read-from-minibuffer 524 "Connect to Host: " (net-utils-machine-at-point)) 525 (read-from-minibuffer "SMB Service: "))) 526 (require 'comint) 527 (let* ((name (format "smbclient [%s\\%s]" host service)) 528 (buf (get-buffer-create (concat "*" name "*"))) 529 (service-name (concat "\\\\" host "\\" service))) 530 (set-buffer buf) 531 (smbclient-mode) 532 (comint-exec buf name smbclient-program nil 533 (if smbclient-program-options 534 (append (list service-name) smbclient-program-options) 535 (list service-name))) 536 (pop-to-buffer buf))) 537 538(defun smbclient-list-shares (host) 539 "List services on HOST." 540 (interactive 541 (list 542 (read-from-minibuffer 543 "Connect to Host: " (net-utils-machine-at-point)))) 544 (let ((buf (get-buffer-create (format "*SMB Shares on %s*" host)))) 545 (set-buffer buf) 546 (smbclient-mode) 547 (comint-exec buf "smbclient-list-shares" 548 smbclient-program nil (list "-L" host)) 549 (pop-to-buffer buf))) 550 551(define-derived-mode smbclient-mode comint-mode "smbclient" 552 "Major mode for interacting with the smbclient program." 553 (setq comint-prompt-regexp smbclient-prompt-regexp) 554 (setq comint-input-autoexpand t) 555 ;; Only add the password-prompting hook if it's not already in the 556 ;; global hook list. This stands a small chance of losing, if it's 557 ;; later removed from the global list (very small, since any 558 ;; password prompts will probably immediately follow the initial 559 ;; connection), but it's better than getting prompted twice for the 560 ;; same password. 561 (unless (memq 'comint-watch-for-password-prompt 562 (default-value 'comint-output-filter-functions)) 563 (add-hook 'comint-output-filter-functions 'comint-watch-for-password-prompt 564 nil t))) 565 566 567;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 568;; Network Connections 569;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 570 571;; Full list is available at: 572;; http://www.iana.org/assignments/port-numbers 573(defvar network-connection-service-alist 574 (list 575 (cons 'echo 7) 576 (cons 'active-users 11) 577 (cons 'daytime 13) 578 (cons 'chargen 19) 579 (cons 'ftp 21) 580 (cons 'telnet 23) 581 (cons 'smtp 25) 582 (cons 'time 37) 583 (cons 'whois 43) 584 (cons 'gopher 70) 585 (cons 'finger 79) 586 (cons 'www 80) 587 (cons 'pop2 109) 588 (cons 'pop3 110) 589 (cons 'sun-rpc 111) 590 (cons 'nntp 119) 591 (cons 'ntp 123) 592 (cons 'netbios-name 137) 593 (cons 'netbios-data 139) 594 (cons 'irc 194) 595 (cons 'https 443) 596 (cons 'rlogin 513)) 597 "Alist of services and associated TCP port numbers. 598This list is not complete.") 599 600;; Workhorse macro 601(defmacro run-network-program (process-name host port 602 &optional initial-string) 603 `(let ((tcp-connection) 604 (buf)) 605 (setq buf (get-buffer-create (concat "*" ,process-name "*"))) 606 (set-buffer buf) 607 (or 608 (setq tcp-connection 609 (open-network-stream 610 ,process-name 611 buf 612 ,host 613 ,port)) 614 (error "Could not open connection to %s" ,host)) 615 (erase-buffer) 616 (set-marker (process-mark tcp-connection) (point-min)) 617 (set-process-filter tcp-connection 'net-utils-remove-ctrl-m-filter) 618 (and ,initial-string 619 (process-send-string tcp-connection 620 (concat ,initial-string "\r\n"))) 621 (display-buffer buf))) 622 623;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 624;; Simple protocols 625;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 626 627(defcustom finger-X.500-host-regexps nil 628 "A list of regular expressions matching host names. 629If a host name passed to `finger' matches one of these regular 630expressions, it is assumed to be a host that doesn't accept 631queries of the form USER@HOST, and wants a query containing USER only." 632 :group 'net-utils 633 :type '(repeat regexp) 634 :version "21.1") 635 636;; Finger protocol 637;;;###autoload 638(defun finger (user host) 639 "Finger USER on HOST." 640 ;; One of those great interactive statements that's actually 641 ;; longer than the function call! The idea is that if the user 642 ;; uses a string like "pbreton@cs.umb.edu", we won't ask for the 643 ;; host name. If we don't see an "@", we'll prompt for the host. 644 (interactive 645 (let* ((answer (read-from-minibuffer "Finger User: " 646 (net-utils-url-at-point))) 647 (index (string-match (regexp-quote "@") answer))) 648 (if index 649 (list (substring answer 0 index) 650 (substring answer (1+ index))) 651 (list answer 652 (read-from-minibuffer "At Host: " 653 (net-utils-machine-at-point)))))) 654 (let* ((user-and-host (concat user "@" host)) 655 (process-name (concat "Finger [" user-and-host "]")) 656 (regexps finger-X.500-host-regexps) 657 found) 658 (and regexps 659 (while (not (string-match (car regexps) host)) 660 (setq regexps (cdr regexps))) 661 (when regexps 662 (setq user-and-host user))) 663 (run-network-program 664 process-name 665 host 666 (cdr (assoc 'finger network-connection-service-alist)) 667 user-and-host))) 668 669(defcustom whois-server-name "rs.internic.net" 670 "Default host name for the whois service." 671 :group 'net-utils 672 :type 'string) 673 674(defcustom whois-server-list 675 '(("whois.arin.net") ; Networks, ASN's, and related POC's (numbers) 676 ("rs.internic.net") ; domain related info 677 ("whois.publicinterestregistry.net") 678 ("whois.abuse.net") 679 ("whois.apnic.net") 680 ("nic.ddn.mil") 681 ("whois.nic.mil") 682 ("whois.nic.gov") 683 ("whois.ripe.net")) 684 "A list of whois servers that can be queried." 685 :group 'net-utils 686 :type '(repeat (list string))) 687 688;; FIXME: modern whois clients include a much better tld <-> whois server 689;; list, Emacs should probably avoid specifying the server as the client 690;; will DTRT anyway... -rfr 691(defcustom whois-server-tld 692 '(("rs.internic.net" . "com") 693 ("whois.publicinterestregistry.net" . "org") 694 ("whois.ripe.net" . "be") 695 ("whois.ripe.net" . "de") 696 ("whois.ripe.net" . "dk") 697 ("whois.ripe.net" . "it") 698 ("whois.ripe.net" . "fi") 699 ("whois.ripe.net" . "fr") 700 ("whois.ripe.net" . "uk") 701 ("whois.apnic.net" . "au") 702 ("whois.apnic.net" . "ch") 703 ("whois.apnic.net" . "hk") 704 ("whois.apnic.net" . "jp") 705 ("whois.nic.gov" . "gov") 706 ("whois.nic.mil" . "mil")) 707 "Alist to map top level domains to whois servers." 708 :group 'net-utils 709 :type '(repeat (cons string string))) 710 711(defcustom whois-guess-server t 712 "If non-nil then whois will try to deduce the appropriate whois 713server from the query. If the query doesn't look like a domain or hostname 714then the server named by `whois-server-name' is used." 715 :group 'net-utils 716 :type 'boolean) 717 718(defun whois-get-tld (host) 719 "Return the top level domain of `host', or nil if it isn't a domain name." 720 (let ((i (1- (length host))) 721 (max-len (- (length host) 5))) 722 (while (not (or (= i max-len) (char-equal (aref host i) ?.))) 723 (setq i (1- i))) 724 (if (= i max-len) 725 nil 726 (substring host (1+ i))))) 727 728;; Whois protocol 729;;;###autoload 730(defun whois (arg search-string) 731 "Send SEARCH-STRING to server defined by the `whois-server-name' variable. 732If `whois-guess-server' is non-nil, then try to deduce the correct server 733from SEARCH-STRING. With argument, prompt for whois server." 734 (interactive "P\nsWhois: ") 735 (let* ((whois-apropos-host (if whois-guess-server 736 (rassoc (whois-get-tld search-string) 737 whois-server-tld) 738 nil)) 739 (server-name (if whois-apropos-host 740 (car whois-apropos-host) 741 whois-server-name)) 742 (host 743 (if arg 744 (completing-read "Whois server name: " 745 whois-server-list nil nil "whois.") 746 server-name))) 747 (run-network-program 748 "Whois" 749 host 750 (cdr (assoc 'whois network-connection-service-alist)) 751 search-string))) 752 753(defcustom whois-reverse-lookup-server "whois.arin.net" 754 "Server which provides inverse DNS mapping." 755 :group 'net-utils 756 :type 'string) 757 758;;;###autoload 759(defun whois-reverse-lookup () 760 (interactive) 761 (let ((whois-server-name whois-reverse-lookup-server)) 762 (call-interactively 'whois))) 763 764;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 765;;; General Network connection 766;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 767 768;; Using a derived mode gives us keymaps, hooks, etc. 769(define-derived-mode 770 network-connection-mode comint-mode "Network-Connection" 771 "Major mode for interacting with the network-connection program.") 772 773(defun network-connection-mode-setup (host service) 774 (make-local-variable 'network-connection-host) 775 (setq network-connection-host host) 776 (make-local-variable 'network-connection-service) 777 (setq network-connection-service service)) 778 779;;;###autoload 780(defun network-connection-to-service (host service) 781 "Open a network connection to SERVICE on HOST." 782 (interactive 783 (list 784 (read-from-minibuffer "Host: " (net-utils-machine-at-point)) 785 (completing-read "Service: " 786 (mapcar 787 (function 788 (lambda (elt) 789 (list (symbol-name (car elt))))) 790 network-connection-service-alist)))) 791 (network-connection 792 host 793 (cdr (assoc (intern service) network-connection-service-alist)))) 794 795;;;###autoload 796(defun network-connection (host port) 797 "Open a network connection to HOST on PORT." 798 (interactive "sHost: \nnPort: ") 799 (network-service-connection host (number-to-string port))) 800 801(defun network-service-connection (host service) 802 "Open a network connection to SERVICE on HOST." 803 (require 'comint) 804 (let* ((process-name (concat "Network Connection [" host " " service "]")) 805 (portnum (string-to-number service)) 806 (buf (get-buffer-create (concat "*" process-name "*")))) 807 (or (zerop portnum) (setq service portnum)) 808 (make-comint 809 process-name 810 (cons host service)) 811 (set-buffer buf) 812 (network-connection-mode) 813 (network-connection-mode-setup host service) 814 (pop-to-buffer buf))) 815 816(defun network-connection-reconnect () 817 "Reconnect a network connection, preserving the old input ring." 818 (interactive) 819 (let ((proc (get-buffer-process (current-buffer))) 820 (old-comint-input-ring comint-input-ring) 821 (host network-connection-host) 822 (service network-connection-service)) 823 (if (not (or (not proc) 824 (eq (process-status proc) 'closed))) 825 (message "Still connected") 826 (goto-char (point-max)) 827 (insert (format "Reopening connection to %s\n" host)) 828 (network-connection host 829 (if (numberp service) 830 service 831 (cdr (assoc service network-connection-service-alist)))) 832 (and old-comint-input-ring 833 (setq comint-input-ring old-comint-input-ring))))) 834 835(provide 'net-utils) 836 837;;; arch-tag: 97119e91-9edb-4376-838b-bf7058fa1314 838;;; net-utils.el ends here 839