pax_global_header00006660000000000000000000000064147141613100014510gustar00rootroot0000000000000052 comment=41af07fea808f37dd83d6fee7019a58b1fa6ed03 guile-ssh-0.18.0/000077500000000000000000000000001471416131000134765ustar00rootroot00000000000000guile-ssh-0.18.0/.dir-locals.el000066400000000000000000000011001471416131000161170ustar00rootroot00000000000000;;; .dir-locals.el -- Per-directory local variables for GNU Emacs 23 and later. ((nil . ((fill-column . 78) (tab-width . 8))) (c-mode . ((c-file-style . "gnu"))) (scheme-mode . ((indent-tabs-mode . nil) (eval . (put 'test-assert 'scheme-indent-function 1)) (eval . (put 'with-ssh 'scheme-indent-function 1)) (eval . (put 'test-assert-with-log 'scheme-indent-function 1)) (eval . (put 'test-error-with-log 'scheme-indent-function 1))))) ;;; .dir-locals.el ends here guile-ssh-0.18.0/.github/000077500000000000000000000000001471416131000150365ustar00rootroot00000000000000guile-ssh-0.18.0/.github/FUNDING.yml000066400000000000000000000014031471416131000166510ustar00rootroot00000000000000# These are supported funding model platforms github: # Replace with up to 4 GitHub Sponsors-enabled usernames e.g., [user1, user2] patreon: # Replace with a single Patreon username open_collective: # Replace with a single Open Collective username ko_fi: # Replace with a single Ko-fi username tidelift: # Replace with a single Tidelift platform-name/package-name e.g., npm/babel community_bridge: # Replace with a single Community Bridge project-name e.g., cloud-foundry liberapay: # avp issuehunt: # Replace with a single IssueHunt username otechie: # Replace with a single Otechie username # Replace with up to 4 custom sponsorship URLs e.g., ['link1', 'link2'] custom: ['https://www.blockchain.com/explorer/addresses/btc/bc1qp7vwxnp4z05fgedfsrqeqvt89fjwnnghng0vp5'] guile-ssh-0.18.0/.github/workflows/000077500000000000000000000000001471416131000170735ustar00rootroot00000000000000guile-ssh-0.18.0/.github/workflows/fedora.yml000066400000000000000000000007731471416131000210650ustar00rootroot00000000000000name: Fedora/Guile 2.2 on: push: branches: - '*' pull_request: branches: [ master ] jobs: build: name: Required Packages strategy: matrix: distro: - 'avvp/fedora-guile:latest' runs-on: ubuntu-latest steps: - uses: actions/checkout@v1 - name: Test building on ${{ matrix.distro }} run: | docker run --rm -v $PWD:/guile-ssh -w /guile-ssh ${{ matrix.distro }} /bin/sh -c 'autoreconf -vif && ./configure && make check' guile-ssh-0.18.0/.github/workflows/guile2.2.yml000066400000000000000000000020551471416131000211470ustar00rootroot00000000000000name: Ubuntu/Guile 2.2 on: push: branches: [ master ] pull_request: branches: [ master ] jobs: build: runs-on: ubuntu-latest steps: - name: Install dependencies run: | sudo apt update sudo apt install guile-2.2 guile-2.2-libs guile-library sudo apt install guile-2.2-dev texinfo texlive sudo apt install automake autoconf sudo apt install libssh-dev sudo apt install libtool sudo apt install gcc-9 - name: Checkout repository uses: actions/checkout@v2 - name: Autoreconf run: autoreconf -vif - name: Configure run: ./configure - name: Make run: make -j$(nproc) - name: Run tests run: make -j$(nproc) check - name: Make distribution run: make -j$(nproc) distcheck - name: Upload the artifact id: upload-artifact uses: actions/upload-artifact@v4 with: name: guile-ssh compression-level: 0 path: "guile-ssh-*.tar.gz" guile-ssh-0.18.0/.github/workflows/guile3.0.yml000066400000000000000000000021071471416131000211440ustar00rootroot00000000000000name: Ubuntu/Guile 3.0 on: push: branches: [ master ] pull_request: branches: [ master ] jobs: build: runs-on: ubuntu-latest steps: - name: Install dependencies run: | sudo apt -qy install \ guile-3.0 \ guile-3.0-libs \ guile-3.0-dev \ guile-library \ texinfo \ libssh-dev \ libtool \ texlive \ gettext \ make \ automake \ autoconf \ gcc - uses: actions/checkout@v2 - name: Autoreconf run: autoreconf -vif - name: Configure run: ./configure - name: Build run: make -j$(nproc) - name: Run tests run: make -j$(nproc) check - name: Make distribution run: make -j$(nproc) distcheck - name: Upload the artifact id: upload-artifact uses: actions/upload-artifact@v4 with: name: guile-ssh compression-level: 0 path: "guile-ssh-*.tar.gz" guile-ssh-0.18.0/.github/workflows/guix.yml000066400000000000000000000121731471416131000205760ustar00rootroot00000000000000--- # File : guix.yml name: Guix/Guile 3.0 on: push: branches: - master pull_request: branches: - master jobs: x86_64-linux-gnu: runs-on: "ubuntu-latest" steps: - name: "Guix cache" uses: "actions/cache@v3" with: path: "~/.cache/guix" # use a key that (almost) never matches key: "guix-cache-${{ github.sha }}" restore-keys: | guix-cache- - name: "Install Guix" uses: "PromyLOPh/guix-install-action@v1" - name: "Ensure no locale warning" run: | test -z "$(guix --version 2>&1 >/dev/null)" - name: "Checkout repository" uses: "actions/checkout@v3" - name: "Build project guile-ssh" run: | guix build --file=guix.scm x86_64-linux-gnu-libssh-0-8-0: runs-on: "ubuntu-latest" steps: - name: "Guix cache" uses: "actions/cache@v3" with: path: "~/.cache/guix" # use a key that (almost) never matches key: "guix-cache-${{ github.sha }}" restore-keys: | guix-cache- - name: "Install Guix" uses: "PromyLOPh/guix-install-action@v1" - name: "Ensure no locale warning" run: | test -z "$(guix --version 2>&1 >/dev/null)" - name: "Checkout repository" uses: "actions/checkout@v3" - name: "Build project guile-ssh" run: | export GUILE_SSH_BUILD_WITH_LIBSSH_0_8_0=1 guix build --file=guix.scm x86_64-linux-gnu-libssh-0-8-1: runs-on: "ubuntu-latest" steps: - name: "Guix cache" uses: "actions/cache@v3" with: path: "~/.cache/guix" # use a key that (almost) never matches key: "guix-cache-${{ github.sha }}" restore-keys: | guix-cache- - name: "Install Guix" uses: "PromyLOPh/guix-install-action@v1" - name: "Ensure no locale warning" run: | test -z "$(guix --version 2>&1 >/dev/null)" - name: "Checkout repository" uses: "actions/checkout@v3" - name: "Build project guile-ssh" run: | export GUILE_SSH_BUILD_WITH_LIBSSH_0_8_1=1 guix build --file=guix.scm x86_64-linux-gnu-libssh-0-8: runs-on: "ubuntu-latest" steps: - name: "Guix cache" uses: "actions/cache@v3" with: path: "~/.cache/guix" # use a key that (almost) never matches key: "guix-cache-${{ github.sha }}" restore-keys: | guix-cache- - name: "Install Guix" uses: "PromyLOPh/guix-install-action@v1" - name: "Ensure no locale warning" run: | test -z "$(guix --version 2>&1 >/dev/null)" - name: "Checkout repository" uses: "actions/checkout@v3" - name: "Build project guile-ssh" run: | export GUILE_SSH_BUILD_WITH_LIBSSH_0_8=1 guix build --file=guix.scm x86_64-linux-gnu-libssh-0-9: runs-on: "ubuntu-latest" steps: - name: "Guix cache" uses: "actions/cache@v3" with: path: "~/.cache/guix" # use a key that (almost) never matches key: "guix-cache-${{ github.sha }}" restore-keys: | guix-cache- - name: "Install Guix" uses: "PromyLOPh/guix-install-action@v1" - name: "Ensure no locale warning" run: | test -z "$(guix --version 2>&1 >/dev/null)" - name: "Checkout repository" uses: "actions/checkout@v3" - name: "Build project guile-ssh" run: | export GUILE_SSH_BUILD_WITH_LIBSSH_0_9=1 guix build --file=guix.scm x86_64-linux-gnu-libssh-0-11: # This tests handling of DSA deprecation in libssh 0.11 among other # things. runs-on: "ubuntu-latest" steps: - name: "Guix cache" uses: "actions/cache@v3" with: path: "~/.cache/guix" # use a key that (almost) never matches key: "guix-cache-${{ github.sha }}" restore-keys: | guix-cache- - name: "Install Guix" uses: "PromyLOPh/guix-install-action@v1" - name: "Ensure no locale warning" run: | test -z "$(guix --version 2>&1 >/dev/null)" - name: "Checkout repository" uses: "actions/checkout@v3" - name: "Build project guile-ssh" run: | export GUILE_SSH_BUILD_WITH_LIBSSH_0_11=1 guix build --file=guix.scm aarch64-linux-gnu: runs-on: "ubuntu-latest" steps: - name: "Guix cache" uses: "actions/cache@v3" with: path: "~/.cache/guix" # use a key that (almost) never matches key: "guix-cache-${{ github.sha }}" restore-keys: | guix-cache- - name: "Install Guix" uses: "PromyLOPh/guix-install-action@v1" - name: "Ensure no locale warning" run: | test -z "$(guix --version 2>&1 >/dev/null)" - name: "Checkout repository" uses: "actions/checkout@v3" - name: "Build project guile-ssh" run: | guix build --target=aarch64-linux-gnu --file=guix.scm # End of guix.yml ... guile-ssh-0.18.0/.gitignore000066400000000000000000000005401471416131000154650ustar00rootroot00000000000000# -*- shell-script -*- # Compiled Scheme files *.go # Backup files *\~ # Auto-generated files Makefile Makefile.in configure *.tar.gz *.tar.gz.sig # Ignore files produced by the magic snarfer *.x config.log config.status .deps autom4te.cache aclocal.m4 libtool TAGS tags GPATH GRTAGS GTAGS /doc/version.texi # Ignore distributions guile-ssh-* guile-ssh-0.18.0/ARCHITECTURE.org000066400000000000000000000054061471416131000160760ustar00rootroot00000000000000#+TITLE: Guile-SSH Architecture #+STARTUP: content hidestars Copyright (C) Artyom V. Poptsov Copying and distribution of this file, with or without modification, are permitted in any medium without royalty provided the copyright notice and this notice are preserved. * Architecture The main goal of this project is to provide a [[https://www.gnu.org/software/guile/][GNU Guile]] (Scheme) interface to [[https://www.libssh.org/][libssh]] library which in turn implements [[https://en.wikipedia.org/wiki/Secure_Shell][SSH protocol]] (RFC 4250 and others.) There are two main reasons that Guile-SSH uses libssh: 1. It was originally started as a wrapper to the libssh. 2. It's not easy to do the implementation of SSH protocol right; as it is the foundation for secure communication there's a great burden of maintaining the security of the code. =libssh= has comprehensive testing, it is passed at least one [[https://www.libssh.org/2019/12/10/libssh-0-9-3-and-libssh-0-8-8-security-release/][security audit]] and it has many users. In addition to the basic SSH client/server API (provided by libssh itself) Guile-SSH provides high-level procedures for operations over SSH channels. The project is split into two parts: a C library (=libguile-ssh=) and a Scheme =ssh= library. ** Code Map *** Overview C library code is in =libguile-ssh= directory. All the GNU Guile modules are in =modules= directory. *** C API C API is not public at the moment as it is not important for the task Guile-SSH tries accomplish. Nevertheless public and stable C API might be advantageous in some situations like writing other low-level Scheme libraries or low-level Guile-SSH testing. Each SMOB (Small Object) -- a GNU Guile object described in C -- is split into three files: - =*-type.c= contains the implementation of a SMOB and some very basic procedures for it. - =*-func.c= contains the most of the procedures for working with that SMOB. - =*-main.c= contains the =init= procedure that initializes the SMOB. There are some common procedures that are written in separate files not related to any SMOB (like =log= procedures.) *** Scheme API Scheme API is public and should be kept stable when it's possible. When this API changes a note must be issued in the =NEWS= file. All Scheme modules are in =modules/ssh= directory. *** Examples Examples are important as they provide a hint how the library can be used for real tasks. Guile-SSH examples are stored in =examples= directory in the root of the repository. *** Tests Tests are in =tests= directory. They are written using SRFI-61. When a new functionality is being added a new test case (or several test cases) should be written for it. Tests are using SSH client and a server written in Guile-SSH from =examples=. guile-ssh-0.18.0/AUTHORS000066400000000000000000000051511471416131000145500ustar00rootroot00000000000000Authors of Guile-SSH See also files THANKS and ChangeLog. * Artyom V. Poptsov The author and current maintainer. * David Kastrup Pointed out to the bug in Guile-SSH SMOB freeing code. * David Thompson Bug reports, various comments and suggestions. * Ludovic Courtès In the root directory, changes to: m4/guile.m4, m4/lib-link.m4, m4/lib-ld.m4, m4/lib-prefix.m4, build-aux/compile, build-aux/config.rpath, Makefile.am, configure.ac am/guilec In subdirectory 'libguile-ssh', changes to: auth.c channel-func.c channel-main.c channel-type.c common.c common.h configure.ac error.c key-func.c key-main.c key-type.c key-type.h log.c message-func.c message-type.c server-func.c server-main.c server-type.c session-func.c session-func.c session-main.c session-type.c sftp-file-main.c sftp-file-type.c sftp-file-type.c sftp-session-func.c sftp-session-main.c sftp-session-type.c threads.c version.c In subdirectory 'tests', changes to: common.scm sssh-ssshd.scm In subdirectory 'examples', changes to: Makefile.am Guile 3.0 support. Bug reports, various comments and suggestions. * Mathieu Othacehe Pointed out to bugs in 'rrepl-get-result' from (ssh dist node). Cross-compilation fixes. * Marius Bakke Pointed out to buigs in 'node-run-server' from (ssh dist node). * Ting-Wei Lan Bug reports. Author and maintainer of an AUR package for Arch GNU/Linux: * Lars-Dominik Braun GSSAPI support. * Aleix Conchillo Flaqué Fixed Guile-SSH building on macOS. Also packaged the library for Homebrew package manager. In the root directory, changes to: configure.ac In subdirectory 'modules/ssh/', changes to: Makefile.am In subdirectory 'modules/ssh/dist/', changes to: Makefile.am In subdirectory 'tests', changes to: Makefile.am common.scm sssh-ssshd.scm * Andrew Tropin Bug reports. * Sharlatan Hellseher GNU Guix workflows for GitHub CI. * Maxim Cournoyer Fixes for typos in the Texinfo documentation. * Darya Sev. Very helpful design advices for the new simplified version of the project logo. * Peter Tillemans Changes to 'libguile-ssh/session-func.c': fix compile error caused by bool identifier.guile-ssh-0.18.0/CODE_OF_CONDUCT.org000066400000000000000000000132131471416131000164640ustar00rootroot00000000000000* Contributor Covenant Code of Conduct :PROPERTIES: :CUSTOM_ID: contributor-covenant-code-of-conduct :END: ** Our Pledge :PROPERTIES: :CUSTOM_ID: our-pledge :END: We as members, contributors, and leaders pledge to make participation in our community a harassment-free experience for everyone, regardless of age, body size, visible or invisible disability, ethnicity, sex characteristics, gender identity and expression, level of experience, education, socio-economic status, nationality, personal appearance, race, caste, color, religion, or sexual identity and orientation. We pledge to act and interact in ways that contribute to an open, welcoming, diverse, inclusive, and healthy community. ** Our Standards :PROPERTIES: :CUSTOM_ID: our-standards :END: Examples of behavior that contributes to a positive environment for our community include: - Demonstrating empathy and kindness toward other people - Being respectful of differing opinions, viewpoints, and experiences - Giving and gracefully accepting constructive feedback - Accepting responsibility and apologizing to those affected by our mistakes, and learning from the experience - Focusing on what is best not just for us as individuals, but for the overall community Examples of unacceptable behavior include: - The use of sexualized language or imagery, and sexual attention or advances of any kind - Trolling, insulting or derogatory comments, and personal or political attacks - Public or private harassment - Publishing others' private information, such as a physical or email address, without their explicit permission - Other conduct which could reasonably be considered inappropriate in a professional setting ** Enforcement Responsibilities :PROPERTIES: :CUSTOM_ID: enforcement-responsibilities :END: Community leaders are responsible for clarifying and enforcing our standards of acceptable behavior and will take appropriate and fair corrective action in response to any behavior that they deem inappropriate, threatening, offensive, or harmful. Community leaders have the right and responsibility to remove, edit, or reject comments, commits, code, wiki edits, issues, and other contributions that are not aligned to this Code of Conduct, and will communicate reasons for moderation decisions when appropriate. ** Scope :PROPERTIES: :CUSTOM_ID: scope :END: This Code of Conduct applies within all community spaces, and also applies when an individual is officially representing the community in public spaces. Examples of representing our community include using an official email address, posting via an official social media account, or acting as an appointed representative at an online or offline event. ** Enforcement :PROPERTIES: :CUSTOM_ID: enforcement :END: Instances of abusive, harassing, or otherwise unacceptable behavior may be reported to the community leaders responsible for enforcement at . All complaints will be reviewed and investigated promptly and fairly. All community leaders are obligated to respect the privacy and security of the reporter of any incident. ** Enforcement Guidelines :PROPERTIES: :CUSTOM_ID: enforcement-guidelines :END: Community leaders will follow these Community Impact Guidelines in determining the consequences for any action they deem in violation of this Code of Conduct: *** 1. Correction :PROPERTIES: :CUSTOM_ID: correction :END: *Community Impact*: Use of inappropriate language or other behavior deemed unprofessional or unwelcome in the community. *Consequence*: A private, written warning from community leaders, providing clarity around the nature of the violation and an explanation of why the behavior was inappropriate. A public apology may be requested. *** 2. Warning :PROPERTIES: :CUSTOM_ID: warning :END: *Community Impact*: A violation through a single incident or series of actions. *Consequence*: A warning with consequences for continued behavior. No interaction with the people involved, including unsolicited interaction with those enforcing the Code of Conduct, for a specified period of time. This includes avoiding interactions in community spaces as well as external channels like social media. Violating these terms may lead to a temporary or permanent ban. *** 3. Temporary Ban :PROPERTIES: :CUSTOM_ID: temporary-ban :END: *Community Impact*: A serious violation of community standards, including sustained inappropriate behavior. *Consequence*: A temporary ban from any sort of interaction or public communication with the community for a specified period of time. No public or private interaction with the people involved, including unsolicited interaction with those enforcing the Code of Conduct, is allowed during this period. Violating these terms may lead to a permanent ban. *** 4. Permanent Ban :PROPERTIES: :CUSTOM_ID: permanent-ban :END: *Community Impact*: Demonstrating a pattern of violation of community standards, including sustained inappropriate behavior, harassment of an individual, or aggression toward or disparagement of classes of individuals. *Consequence*: A permanent ban from any sort of public interaction within the community. ** Attribution :PROPERTIES: :CUSTOM_ID: attribution :END: This Code of Conduct is adapted from the [[https://www.contributor-covenant.org][Contributor Covenant]], version 2.1, available at [[https://www.contributor-covenant.org/version/2/1/code_of_conduct.html]]. Community Impact Guidelines were inspired by [[https://github.com/mozilla/diversity][Mozilla's code of conduct enforcement ladder]]. For answers to common questions about this code of conduct, see the FAQ at [[https://www.contributor-covenant.org/faq]]. Translations are available at [[https://www.contributor-covenant.org/translations]]. guile-ssh-0.18.0/COPYING000066400000000000000000001045131471416131000145350ustar00rootroot00000000000000 GNU GENERAL PUBLIC LICENSE Version 3, 29 June 2007 Copyright (C) 2007 Free Software Foundation, Inc. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The GNU General Public License is a free, copyleft license for software and other kinds of works. The licenses for most software and other practical works are designed to take away your freedom to share and change the works. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change all versions of a program--to make sure it remains free software for all its users. We, the Free Software Foundation, use the GNU General Public License for most of our software; it applies also to any other work released this way by its authors. You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for them if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs, and that you know you can do these things. To protect your rights, we need to prevent others from denying you these rights or asking you to surrender the rights. Therefore, you have certain responsibilities if you distribute copies of the software, or if you modify it: responsibilities to respect the freedom of others. For example, if you distribute copies of such a program, whether gratis or for a fee, you must pass on to the recipients the same freedoms that you received. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. Developers that use the GNU GPL protect your rights with two steps: (1) assert copyright on the software, and (2) offer you this License giving you legal permission to copy, distribute and/or modify it. For the developers' and authors' protection, the GPL clearly explains that there is no warranty for this free software. For both users' and authors' sake, the GPL requires that modified versions be marked as changed, so that their problems will not be attributed erroneously to authors of previous versions. Some devices are designed to deny users access to install or run modified versions of the software inside them, although the manufacturer can do so. This is fundamentally incompatible with the aim of protecting users' freedom to change the software. The systematic pattern of such abuse occurs in the area of products for individuals to use, which is precisely where it is most unacceptable. Therefore, we have designed this version of the GPL to prohibit the practice for those products. If such problems arise substantially in other domains, we stand ready to extend this provision to those domains in future versions of the GPL, as needed to protect the freedom of users. Finally, every program is threatened constantly by software patents. States should not allow patents to restrict development and use of software on general-purpose computers, but in those that do, we wish to avoid the special danger that patents applied to a free program could make it effectively proprietary. To prevent this, the GPL assures that patents cannot be used to render the program non-free. The precise terms and conditions for copying, distribution and modification follow. TERMS AND CONDITIONS 0. Definitions. "This License" refers to version 3 of the GNU General Public License. "Copyright" also means copyright-like laws that apply to other kinds of works, such as semiconductor masks. "The Program" refers to any copyrightable work licensed under this License. Each licensee is addressed as "you". "Licensees" and "recipients" may be individuals or organizations. To "modify" a work means to copy from or adapt all or part of the work in a fashion requiring copyright permission, other than the making of an exact copy. The resulting work is called a "modified version" of the earlier work or a work "based on" the earlier work. A "covered work" means either the unmodified Program or a work based on the Program. To "propagate" a work means to do anything with it that, without permission, would make you directly or secondarily liable for infringement under applicable copyright law, except executing it on a computer or modifying a private copy. Propagation includes copying, distribution (with or without modification), making available to the public, and in some countries other activities as well. To "convey" a work means any kind of propagation that enables other parties to make or receive copies. Mere interaction with a user through a computer network, with no transfer of a copy, is not conveying. An interactive user interface displays "Appropriate Legal Notices" to the extent that it includes a convenient and prominently visible feature that (1) displays an appropriate copyright notice, and (2) tells the user that there is no warranty for the work (except to the extent that warranties are provided), that licensees may convey the work under this License, and how to view a copy of this License. If the interface presents a list of user commands or options, such as a menu, a prominent item in the list meets this criterion. 1. Source Code. The "source code" for a work means the preferred form of the work for making modifications to it. "Object code" means any non-source form of a work. A "Standard Interface" means an interface that either is an official standard defined by a recognized standards body, or, in the case of interfaces specified for a particular programming language, one that is widely used among developers working in that language. The "System Libraries" of an executable work include anything, other than the work as a whole, that (a) is included in the normal form of packaging a Major Component, but which is not part of that Major Component, and (b) serves only to enable use of the work with that Major Component, or to implement a Standard Interface for which an implementation is available to the public in source code form. A "Major Component", in this context, means a major essential component (kernel, window system, and so on) of the specific operating system (if any) on which the executable work runs, or a compiler used to produce the work, or an object code interpreter used to run it. The "Corresponding Source" for a work in object code form means all the source code needed to generate, install, and (for an executable work) run the object code and to modify the work, including scripts to control those activities. However, it does not include the work's System Libraries, or general-purpose tools or generally available free programs which are used unmodified in performing those activities but which are not part of the work. For example, Corresponding Source includes interface definition files associated with source files for the work, and the source code for shared libraries and dynamically linked subprograms that the work is specifically designed to require, such as by intimate data communication or control flow between those subprograms and other parts of the work. The Corresponding Source need not include anything that users can regenerate automatically from other parts of the Corresponding Source. The Corresponding Source for a work in source code form is that same work. 2. Basic Permissions. All rights granted under this License are granted for the term of copyright on the Program, and are irrevocable provided the stated conditions are met. This License explicitly affirms your unlimited permission to run the unmodified Program. The output from running a covered work is covered by this License only if the output, given its content, constitutes a covered work. This License acknowledges your rights of fair use or other equivalent, as provided by copyright law. You may make, run and propagate covered works that you do not convey, without conditions so long as your license otherwise remains in force. You may convey covered works to others for the sole purpose of having them make modifications exclusively for you, or provide you with facilities for running those works, provided that you comply with the terms of this License in conveying all material for which you do not control copyright. Those thus making or running the covered works for you must do so exclusively on your behalf, under your direction and control, on terms that prohibit them from making any copies of your copyrighted material outside their relationship with you. Conveying under any other circumstances is permitted solely under the conditions stated below. Sublicensing is not allowed; section 10 makes it unnecessary. 3. Protecting Users' Legal Rights From Anti-Circumvention Law. No covered work shall be deemed part of an effective technological measure under any applicable law fulfilling obligations under article 11 of the WIPO copyright treaty adopted on 20 December 1996, or similar laws prohibiting or restricting circumvention of such measures. When you convey a covered work, you waive any legal power to forbid circumvention of technological measures to the extent such circumvention is effected by exercising rights under this License with respect to the covered work, and you disclaim any intention to limit operation or modification of the work as a means of enforcing, against the work's users, your or third parties' legal rights to forbid circumvention of technological measures. 4. Conveying Verbatim Copies. You may convey verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice; keep intact all notices stating that this License and any non-permissive terms added in accord with section 7 apply to the code; keep intact all notices of the absence of any warranty; and give all recipients a copy of this License along with the Program. You may charge any price or no price for each copy that you convey, and you may offer support or warranty protection for a fee. 5. Conveying Modified Source Versions. You may convey a work based on the Program, or the modifications to produce it from the Program, in the form of source code under the terms of section 4, provided that you also meet all of these conditions: a) The work must carry prominent notices stating that you modified it, and giving a relevant date. b) The work must carry prominent notices stating that it is released under this License and any conditions added under section 7. This requirement modifies the requirement in section 4 to "keep intact all notices". c) You must license the entire work, as a whole, under this License to anyone who comes into possession of a copy. This License will therefore apply, along with any applicable section 7 additional terms, to the whole of the work, and all its parts, regardless of how they are packaged. This License gives no permission to license the work in any other way, but it does not invalidate such permission if you have separately received it. d) If the work has interactive user interfaces, each must display Appropriate Legal Notices; however, if the Program has interactive interfaces that do not display Appropriate Legal Notices, your work need not make them do so. A compilation of a covered work with other separate and independent works, which are not by their nature extensions of the covered work, and which are not combined with it such as to form a larger program, in or on a volume of a storage or distribution medium, is called an "aggregate" if the compilation and its resulting copyright are not used to limit the access or legal rights of the compilation's users beyond what the individual works permit. Inclusion of a covered work in an aggregate does not cause this License to apply to the other parts of the aggregate. 6. Conveying Non-Source Forms. You may convey a covered work in object code form under the terms of sections 4 and 5, provided that you also convey the machine-readable Corresponding Source under the terms of this License, in one of these ways: a) Convey the object code in, or embodied in, a physical product (including a physical distribution medium), accompanied by the Corresponding Source fixed on a durable physical medium customarily used for software interchange. b) Convey the object code in, or embodied in, a physical product (including a physical distribution medium), accompanied by a written offer, valid for at least three years and valid for as long as you offer spare parts or customer support for that product model, to give anyone who possesses the object code either (1) a copy of the Corresponding Source for all the software in the product that is covered by this License, on a durable physical medium customarily used for software interchange, for a price no more than your reasonable cost of physically performing this conveying of source, or (2) access to copy the Corresponding Source from a network server at no charge. c) Convey individual copies of the object code with a copy of the written offer to provide the Corresponding Source. This alternative is allowed only occasionally and noncommercially, and only if you received the object code with such an offer, in accord with subsection 6b. d) Convey the object code by offering access from a designated place (gratis or for a charge), and offer equivalent access to the Corresponding Source in the same way through the same place at no further charge. You need not require recipients to copy the Corresponding Source along with the object code. If the place to copy the object code is a network server, the Corresponding Source may be on a different server (operated by you or a third party) that supports equivalent copying facilities, provided you maintain clear directions next to the object code saying where to find the Corresponding Source. Regardless of what server hosts the Corresponding Source, you remain obligated to ensure that it is available for as long as needed to satisfy these requirements. e) Convey the object code using peer-to-peer transmission, provided you inform other peers where the object code and Corresponding Source of the work are being offered to the general public at no charge under subsection 6d. A separable portion of the object code, whose source code is excluded from the Corresponding Source as a System Library, need not be included in conveying the object code work. A "User Product" is either (1) a "consumer product", which means any tangible personal property which is normally used for personal, family, or household purposes, or (2) anything designed or sold for incorporation into a dwelling. In determining whether a product is a consumer product, doubtful cases shall be resolved in favor of coverage. For a particular product received by a particular user, "normally used" refers to a typical or common use of that class of product, regardless of the status of the particular user or of the way in which the particular user actually uses, or expects or is expected to use, the product. A product is a consumer product regardless of whether the product has substantial commercial, industrial or non-consumer uses, unless such uses represent the only significant mode of use of the product. "Installation Information" for a User Product means any methods, procedures, authorization keys, or other information required to install and execute modified versions of a covered work in that User Product from a modified version of its Corresponding Source. The information must suffice to ensure that the continued functioning of the modified object code is in no case prevented or interfered with solely because modification has been made. If you convey an object code work under this section in, or with, or specifically for use in, a User Product, and the conveying occurs as part of a transaction in which the right of possession and use of the User Product is transferred to the recipient in perpetuity or for a fixed term (regardless of how the transaction is characterized), the Corresponding Source conveyed under this section must be accompanied by the Installation Information. But this requirement does not apply if neither you nor any third party retains the ability to install modified object code on the User Product (for example, the work has been installed in ROM). The requirement to provide Installation Information does not include a requirement to continue to provide support service, warranty, or updates for a work that has been modified or installed by the recipient, or for the User Product in which it has been modified or installed. Access to a network may be denied when the modification itself materially and adversely affects the operation of the network or violates the rules and protocols for communication across the network. Corresponding Source conveyed, and Installation Information provided, in accord with this section must be in a format that is publicly documented (and with an implementation available to the public in source code form), and must require no special password or key for unpacking, reading or copying. 7. Additional Terms. "Additional permissions" are terms that supplement the terms of this License by making exceptions from one or more of its conditions. Additional permissions that are applicable to the entire Program shall be treated as though they were included in this License, to the extent that they are valid under applicable law. If additional permissions apply only to part of the Program, that part may be used separately under those permissions, but the entire Program remains governed by this License without regard to the additional permissions. When you convey a copy of a covered work, you may at your option remove any additional permissions from that copy, or from any part of it. (Additional permissions may be written to require their own removal in certain cases when you modify the work.) You may place additional permissions on material, added by you to a covered work, for which you have or can give appropriate copyright permission. Notwithstanding any other provision of this License, for material you add to a covered work, you may (if authorized by the copyright holders of that material) supplement the terms of this License with terms: a) Disclaiming warranty or limiting liability differently from the terms of sections 15 and 16 of this License; or b) Requiring preservation of specified reasonable legal notices or author attributions in that material or in the Appropriate Legal Notices displayed by works containing it; or c) Prohibiting misrepresentation of the origin of that material, or requiring that modified versions of such material be marked in reasonable ways as different from the original version; or d) Limiting the use for publicity purposes of names of licensors or authors of the material; or e) Declining to grant rights under trademark law for use of some trade names, trademarks, or service marks; or f) Requiring indemnification of licensors and authors of that material by anyone who conveys the material (or modified versions of it) with contractual assumptions of liability to the recipient, for any liability that these contractual assumptions directly impose on those licensors and authors. All other non-permissive additional terms are considered "further restrictions" within the meaning of section 10. If the Program as you received it, or any part of it, contains a notice stating that it is governed by this License along with a term that is a further restriction, you may remove that term. If a license document contains a further restriction but permits relicensing or conveying under this License, you may add to a covered work material governed by the terms of that license document, provided that the further restriction does not survive such relicensing or conveying. If you add terms to a covered work in accord with this section, you must place, in the relevant source files, a statement of the additional terms that apply to those files, or a notice indicating where to find the applicable terms. Additional terms, permissive or non-permissive, may be stated in the form of a separately written license, or stated as exceptions; the above requirements apply either way. 8. Termination. You may not propagate or modify a covered work except as expressly provided under this License. Any attempt otherwise to propagate or modify it is void, and will automatically terminate your rights under this License (including any patent licenses granted under the third paragraph of section 11). However, if you cease all violation of this License, then your license from a particular copyright holder is reinstated (a) provisionally, unless and until the copyright holder explicitly and finally terminates your license, and (b) permanently, if the copyright holder fails to notify you of the violation by some reasonable means prior to 60 days after the cessation. Moreover, your license from a particular copyright holder is reinstated permanently if the copyright holder notifies you of the violation by some reasonable means, this is the first time you have received notice of violation of this License (for any work) from that copyright holder, and you cure the violation prior to 30 days after your receipt of the notice. Termination of your rights under this section does not terminate the licenses of parties who have received copies or rights from you under this License. If your rights have been terminated and not permanently reinstated, you do not qualify to receive new licenses for the same material under section 10. 9. Acceptance Not Required for Having Copies. You are not required to accept this License in order to receive or run a copy of the Program. Ancillary propagation of a covered work occurring solely as a consequence of using peer-to-peer transmission to receive a copy likewise does not require acceptance. However, nothing other than this License grants you permission to propagate or modify any covered work. These actions infringe copyright if you do not accept this License. Therefore, by modifying or propagating a covered work, you indicate your acceptance of this License to do so. 10. Automatic Licensing of Downstream Recipients. Each time you convey a covered work, the recipient automatically receives a license from the original licensors, to run, modify and propagate that work, subject to this License. You are not responsible for enforcing compliance by third parties with this License. An "entity transaction" is a transaction transferring control of an organization, or substantially all assets of one, or subdividing an organization, or merging organizations. If propagation of a covered work results from an entity transaction, each party to that transaction who receives a copy of the work also receives whatever licenses to the work the party's predecessor in interest had or could give under the previous paragraph, plus a right to possession of the Corresponding Source of the work from the predecessor in interest, if the predecessor has it or can get it with reasonable efforts. You may not impose any further restrictions on the exercise of the rights granted or affirmed under this License. For example, you may not impose a license fee, royalty, or other charge for exercise of rights granted under this License, and you may not initiate litigation (including a cross-claim or counterclaim in a lawsuit) alleging that any patent claim is infringed by making, using, selling, offering for sale, or importing the Program or any portion of it. 11. Patents. A "contributor" is a copyright holder who authorizes use under this License of the Program or a work on which the Program is based. The work thus licensed is called the contributor's "contributor version". A contributor's "essential patent claims" are all patent claims owned or controlled by the contributor, whether already acquired or hereafter acquired, that would be infringed by some manner, permitted by this License, of making, using, or selling its contributor version, but do not include claims that would be infringed only as a consequence of further modification of the contributor version. For purposes of this definition, "control" includes the right to grant patent sublicenses in a manner consistent with the requirements of this License. Each contributor grants you a non-exclusive, worldwide, royalty-free patent license under the contributor's essential patent claims, to make, use, sell, offer for sale, import and otherwise run, modify and propagate the contents of its contributor version. In the following three paragraphs, a "patent license" is any express agreement or commitment, however denominated, not to enforce a patent (such as an express permission to practice a patent or covenant not to sue for patent infringement). To "grant" such a patent license to a party means to make such an agreement or commitment not to enforce a patent against the party. If you convey a covered work, knowingly relying on a patent license, and the Corresponding Source of the work is not available for anyone to copy, free of charge and under the terms of this License, through a publicly available network server or other readily accessible means, then you must either (1) cause the Corresponding Source to be so available, or (2) arrange to deprive yourself of the benefit of the patent license for this particular work, or (3) arrange, in a manner consistent with the requirements of this License, to extend the patent license to downstream recipients. "Knowingly relying" means you have actual knowledge that, but for the patent license, your conveying the covered work in a country, or your recipient's use of the covered work in a country, would infringe one or more identifiable patents in that country that you have reason to believe are valid. If, pursuant to or in connection with a single transaction or arrangement, you convey, or propagate by procuring conveyance of, a covered work, and grant a patent license to some of the parties receiving the covered work authorizing them to use, propagate, modify or convey a specific copy of the covered work, then the patent license you grant is automatically extended to all recipients of the covered work and works based on it. A patent license is "discriminatory" if it does not include within the scope of its coverage, prohibits the exercise of, or is conditioned on the non-exercise of one or more of the rights that are specifically granted under this License. You may not convey a covered work if you are a party to an arrangement with a third party that is in the business of distributing software, under which you make payment to the third party based on the extent of your activity of conveying the work, and under which the third party grants, to any of the parties who would receive the covered work from you, a discriminatory patent license (a) in connection with copies of the covered work conveyed by you (or copies made from those copies), or (b) primarily for and in connection with specific products or compilations that contain the covered work, unless you entered into that arrangement, or that patent license was granted, prior to 28 March 2007. Nothing in this License shall be construed as excluding or limiting any implied license or other defenses to infringement that may otherwise be available to you under applicable patent law. 12. No Surrender of Others' Freedom. If conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot convey a covered work so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not convey it at all. For example, if you agree to terms that obligate you to collect a royalty for further conveying from those to whom you convey the Program, the only way you could satisfy both those terms and this License would be to refrain entirely from conveying the Program. 13. Use with the GNU Affero General Public License. Notwithstanding any other provision of this License, you have permission to link or combine any covered work with a work licensed under version 3 of the GNU Affero General Public License into a single combined work, and to convey the resulting work. The terms of this License will continue to apply to the part which is the covered work, but the special requirements of the GNU Affero General Public License, section 13, concerning interaction through a network will apply to the combination as such. 14. Revised Versions of this License. The Free Software Foundation may publish revised and/or new versions of the GNU General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies that a certain numbered version of the GNU General Public License "or any later version" applies to it, you have the option of following the terms and conditions either of that numbered version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the GNU General Public License, you may choose any version ever published by the Free Software Foundation. If the Program specifies that a proxy can decide which future versions of the GNU General Public License can be used, that proxy's public statement of acceptance of a version permanently authorizes you to choose that version for the Program. Later license versions may give you additional or different permissions. However, no additional obligations are imposed on any author or copyright holder as a result of your choosing to follow a later version. 15. Disclaimer of Warranty. THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. Limitation of Liability. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. 17. Interpretation of Sections 15 and 16. If the disclaimer of warranty and limitation of liability provided above cannot be given local legal effect according to their terms, reviewing courts shall apply local law that most closely approximates an absolute waiver of all civil liability in connection with the Program, unless a warranty or assumption of liability accompanies a copy of the Program in return for a fee. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively state the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 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 3 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, see . Also add information on how to contact you by electronic and paper mail. If the program does terminal interaction, make it output a short notice like this when it starts in an interactive mode: Copyright (C) This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, your program's commands might be different; for a GUI interface, you would use an "about box". You should also get your employer (if you work as a programmer) or school, if any, to sign a "copyright disclaimer" for the program, if necessary. For more information on this, and how to apply and follow the GNU GPL, see . The GNU General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Lesser General Public License instead of this License. But first, please read . guile-ssh-0.18.0/ChangeLog000066400000000000000000000002521471416131000152470ustar00rootroot00000000000000Normally a ChangeLog is generated at "make dist" time and available in source tarballs. If not, see the Git commit log at . guile-ssh-0.18.0/INSTALL000066400000000000000000000366261471416131000145440ustar00rootroot00000000000000Installation Instructions ************************* Copyright (C) 1994-1996, 1999-2002, 2004-2017, 2020-2021 Free Software Foundation, Inc. Copying and distribution of this file, with or without modification, are permitted in any medium without royalty provided the copyright notice and this notice are preserved. This file is offered as-is, without warranty of any kind. Basic Installation ================== Briefly, the shell command './configure && make && make install' should configure, build, and install this package. The following more-detailed instructions are generic; see the 'README' file for instructions specific to this package. Some packages provide this 'INSTALL' file but do not implement all of the features documented below. The lack of an optional feature in a given package is not necessarily a bug. More recommendations for GNU packages can be found in *note Makefile Conventions: (standards)Makefile Conventions. The 'configure' shell script attempts to guess correct values for various system-dependent variables used during compilation. It uses those values to create a 'Makefile' in each directory of the package. It may also create one or more '.h' files containing system-dependent definitions. Finally, it creates a shell script 'config.status' that you can run in the future to recreate the current configuration, and a file 'config.log' containing compiler output (useful mainly for debugging 'configure'). It can also use an optional file (typically called 'config.cache' and enabled with '--cache-file=config.cache' or simply '-C') that saves the results of its tests to speed up reconfiguring. Caching is disabled by default to prevent problems with accidental use of stale cache files. If you need to do unusual things to compile the package, please try to figure out how 'configure' could check whether to do them, and mail diffs or instructions to the address given in the 'README' so they can be considered for the next release. If you are using the cache, and at some point 'config.cache' contains results you don't want to keep, you may remove or edit it. The file 'configure.ac' (or 'configure.in') is used to create 'configure' by a program called 'autoconf'. You need 'configure.ac' if you want to change it or regenerate 'configure' using a newer version of 'autoconf'. The simplest way to compile this package is: 1. 'cd' to the directory containing the package's source code and type './configure' to configure the package for your system. Running 'configure' might take a while. While running, it prints some messages telling which features it is checking for. 2. Type 'make' to compile the package. 3. Optionally, type 'make check' to run any self-tests that come with the package, generally using the just-built uninstalled binaries. 4. Type 'make install' to install the programs and any data files and documentation. When installing into a prefix owned by root, it is recommended that the package be configured and built as a regular user, and only the 'make install' phase executed with root privileges. 5. Optionally, type 'make installcheck' to repeat any self-tests, but this time using the binaries in their final installed location. This target does not install anything. Running this target as a regular user, particularly if the prior 'make install' required root privileges, verifies that the installation completed correctly. 6. You can remove the program binaries and object files from the source code directory by typing 'make clean'. To also remove the files that 'configure' created (so you can compile the package for a different kind of computer), type 'make distclean'. There is also a 'make maintainer-clean' target, but that is intended mainly for the package's developers. If you use it, you may have to get all sorts of other programs in order to regenerate files that came with the distribution. 7. Often, you can also type 'make uninstall' to remove the installed files again. In practice, not all packages have tested that uninstallation works correctly, even though it is required by the GNU Coding Standards. 8. Some packages, particularly those that use Automake, provide 'make distcheck', which can by used by developers to test that all other targets like 'make install' and 'make uninstall' work correctly. This target is generally not run by end users. Compilers and Options ===================== Some systems require unusual options for compilation or linking that the 'configure' script does not know about. Run './configure --help' for details on some of the pertinent environment variables. You can give 'configure' initial values for configuration parameters by setting variables in the command line or in the environment. Here is an example: ./configure CC=c99 CFLAGS=-g LIBS=-lposix *Note Defining Variables::, for more details. Compiling For Multiple Architectures ==================================== You can compile the package for more than one kind of computer at the same time, by placing the object files for each architecture in their own directory. To do this, you can use GNU 'make'. 'cd' to the directory where you want the object files and executables to go and run the 'configure' script. 'configure' automatically checks for the source code in the directory that 'configure' is in and in '..'. This is known as a "VPATH" build. With a non-GNU 'make', it is safer to compile the package for one architecture at a time in the source code directory. After you have installed the package for one architecture, use 'make distclean' before reconfiguring for another architecture. On MacOS X 10.5 and later systems, you can create libraries and executables that work on multiple system types--known as "fat" or "universal" binaries--by specifying multiple '-arch' options to the compiler but only a single '-arch' option to the preprocessor. Like this: ./configure CC="gcc -arch i386 -arch x86_64 -arch ppc -arch ppc64" \ CXX="g++ -arch i386 -arch x86_64 -arch ppc -arch ppc64" \ CPP="gcc -E" CXXCPP="g++ -E" This is not guaranteed to produce working output in all cases, you may have to build one architecture at a time and combine the results using the 'lipo' tool if you have problems. Installation Names ================== By default, 'make install' installs the package's commands under '/usr/local/bin', include files under '/usr/local/include', etc. You can specify an installation prefix other than '/usr/local' by giving 'configure' the option '--prefix=PREFIX', where PREFIX must be an absolute file name. You can specify separate installation prefixes for architecture-specific files and architecture-independent files. If you pass the option '--exec-prefix=PREFIX' to 'configure', the package uses PREFIX as the prefix for installing programs and libraries. Documentation and other data files still use the regular prefix. In addition, if you use an unusual directory layout you can give options like '--bindir=DIR' to specify different values for particular kinds of files. Run 'configure --help' for a list of the directories you can set and what kinds of files go in them. In general, the default for these options is expressed in terms of '${prefix}', so that specifying just '--prefix' will affect all of the other directory specifications that were not explicitly provided. The most portable way to affect installation locations is to pass the correct locations to 'configure'; however, many packages provide one or both of the following shortcuts of passing variable assignments to the 'make install' command line to change installation locations without having to reconfigure or recompile. The first method involves providing an override variable for each affected directory. For example, 'make install prefix=/alternate/directory' will choose an alternate location for all directory configuration variables that were expressed in terms of '${prefix}'. Any directories that were specified during 'configure', but not in terms of '${prefix}', must each be overridden at install time for the entire installation to be relocated. The approach of makefile variable overrides for each directory variable is required by the GNU Coding Standards, and ideally causes no recompilation. However, some platforms have known limitations with the semantics of shared libraries that end up requiring recompilation when using this method, particularly noticeable in packages that use GNU Libtool. The second method involves providing the 'DESTDIR' variable. For example, 'make install DESTDIR=/alternate/directory' will prepend '/alternate/directory' before all installation names. The approach of 'DESTDIR' overrides is not required by the GNU Coding Standards, and does not work on platforms that have drive letters. On the other hand, it does better at avoiding recompilation issues, and works well even when some directory options were not specified in terms of '${prefix}' at 'configure' time. Optional Features ================= If the package supports it, you can cause programs to be installed with an extra prefix or suffix on their names by giving 'configure' the option '--program-prefix=PREFIX' or '--program-suffix=SUFFIX'. Some packages pay attention to '--enable-FEATURE' options to 'configure', where FEATURE indicates an optional part of the package. They may also pay attention to '--with-PACKAGE' options, where PACKAGE is something like 'gnu-as' or 'x' (for the X Window System). The 'README' should mention any '--enable-' and '--with-' options that the package recognizes. For packages that use the X Window System, 'configure' can usually find the X include and library files automatically, but if it doesn't, you can use the 'configure' options '--x-includes=DIR' and '--x-libraries=DIR' to specify their locations. Some packages offer the ability to configure how verbose the execution of 'make' will be. For these packages, running './configure --enable-silent-rules' sets the default to minimal output, which can be overridden with 'make V=1'; while running './configure --disable-silent-rules' sets the default to verbose, which can be overridden with 'make V=0'. Particular systems ================== On HP-UX, the default C compiler is not ANSI C compatible. If GNU CC is not installed, it is recommended to use the following options in order to use an ANSI C compiler: ./configure CC="cc -Ae -D_XOPEN_SOURCE=500" and if that doesn't work, install pre-built binaries of GCC for HP-UX. HP-UX 'make' updates targets which have the same timestamps as their prerequisites, which makes it generally unusable when shipped generated files such as 'configure' are involved. Use GNU 'make' instead. On OSF/1 a.k.a. Tru64, some versions of the default C compiler cannot parse its '' header file. The option '-nodtk' can be used as a workaround. If GNU CC is not installed, it is therefore recommended to try ./configure CC="cc" and if that doesn't work, try ./configure CC="cc -nodtk" On Solaris, don't put '/usr/ucb' early in your 'PATH'. This directory contains several dysfunctional programs; working variants of these programs are available in '/usr/bin'. So, if you need '/usr/ucb' in your 'PATH', put it _after_ '/usr/bin'. On Haiku, software installed for all users goes in '/boot/common', not '/usr/local'. It is recommended to use the following options: ./configure --prefix=/boot/common Specifying the System Type ========================== There may be some features 'configure' cannot figure out automatically, but needs to determine by the type of machine the package will run on. Usually, assuming the package is built to be run on the _same_ architectures, 'configure' can figure that out, but if it prints a message saying it cannot guess the machine type, give it the '--build=TYPE' option. TYPE can either be a short name for the system type, such as 'sun4', or a canonical name which has the form: CPU-COMPANY-SYSTEM where SYSTEM can have one of these forms: OS KERNEL-OS See the file 'config.sub' for the possible values of each field. If 'config.sub' isn't included in this package, then this package doesn't need to know the machine type. If you are _building_ compiler tools for cross-compiling, you should use the option '--target=TYPE' to select the type of system they will produce code for. If you want to _use_ a cross compiler, that generates code for a platform different from the build platform, you should specify the "host" platform (i.e., that on which the generated programs will eventually be run) with '--host=TYPE'. Sharing Defaults ================ If you want to set default values for 'configure' scripts to share, you can create a site shell script called 'config.site' that gives default values for variables like 'CC', 'cache_file', and 'prefix'. 'configure' looks for 'PREFIX/share/config.site' if it exists, then 'PREFIX/etc/config.site' if it exists. Or, you can set the 'CONFIG_SITE' environment variable to the location of the site script. A warning: not all 'configure' scripts look for a site script. Defining Variables ================== Variables not defined in a site shell script can be set in the environment passed to 'configure'. However, some packages may run configure again during the build, and the customized values of these variables may be lost. In order to avoid this problem, you should set them in the 'configure' command line, using 'VAR=value'. For example: ./configure CC=/usr/local2/bin/gcc causes the specified 'gcc' to be used as the C compiler (unless it is overridden in the site shell script). Unfortunately, this technique does not work for 'CONFIG_SHELL' due to an Autoconf limitation. Until the limitation is lifted, you can use this workaround: CONFIG_SHELL=/bin/bash ./configure CONFIG_SHELL=/bin/bash 'configure' Invocation ====================== 'configure' recognizes the following options to control how it operates. '--help' '-h' Print a summary of all of the options to 'configure', and exit. '--help=short' '--help=recursive' Print a summary of the options unique to this package's 'configure', and exit. The 'short' variant lists options used only in the top level, while the 'recursive' variant lists options also present in any nested packages. '--version' '-V' Print the version of Autoconf used to generate the 'configure' script, and exit. '--cache-file=FILE' Enable the cache: use and save the results of the tests in FILE, traditionally 'config.cache'. FILE defaults to '/dev/null' to disable caching. '--config-cache' '-C' Alias for '--cache-file=config.cache'. '--quiet' '--silent' '-q' Do not print messages saying which checks are being made. To suppress all normal output, redirect it to '/dev/null' (any error messages will still be shown). '--srcdir=DIR' Look for the package's source code in directory DIR. Usually 'configure' can determine that directory automatically. '--prefix=DIR' Use DIR as the installation prefix. *note Installation Names:: for more details, including other options available for fine-tuning the installation locations. '--no-create' '-n' Run the configure checks, but stop before creating any output files. 'configure' also accepts some other, not widely useful, options. Run 'configure --help' for more details. guile-ssh-0.18.0/Makefile.am000066400000000000000000000025111471416131000155310ustar00rootroot00000000000000## Config file for GNU Automake. ## ## Copyright (C) 2013, 2014, 2015, 2016 Artyom V. Poptsov ## ## This file is part of Guile-SSH. ## ## Guile-SSH 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 3 of the ## License, or (at your option) any later version. ## ## Guile-SSH 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 Guile-SSH. If not, see . ACLOCAL_AMFLAGS = -I build-aux/m4 --install SUBDIRS = build-aux libguile-ssh examples doc modules tests EXTRA_DIST = \ build-aux/config.rpath \ build-aux/compile \ .dir-locals.el \ TODO gen-ChangeLog: if test -d .git; then \ $(top_srcdir)/build-aux/gitlog-to-changelog \ 194fd7d..HEAD > $(distdir)/cl-t; \ rm -f $(distdir)/ChangeLog; \ mv $(distdir)/cl-t $(distdir)/ChangeLog; \ fi dist-hook: gen-ChangeLog .PHONY: gen-ChangeLog clean-go: @cd modules; make clean-go .PHONY: clean-go ## Makefile.am ends here guile-ssh-0.18.0/NEWS000066400000000000000000001231401471416131000141760ustar00rootroot00000000000000#+TITLE: Guile-SSH News -- history of user-visible changes. #+STARTUP: content hidestars Copyright (C) Artyom V. Poptsov Copying and distribution of this file, with or without modification, are permitted in any medium without royalty provided the copyright notice and this notice are preserved. * Changes in version 0.18.0 (2024-11-10) ** Change =(ssh popen)= procedures behavior :API_CHANGE: Now the following procedures handle the program arguments the same way as =open-pipe*= procedure. This also makes the their behavior match the description from the Guile-SSH documentation. This change affects the following procedures from =(ssh popen)=: - =open-remote-pipe*= - =open-remote-input-pipe*= - =open-remote-output-pipe*= Reported by graywolf in ** =make-session= now handles =#:config= set to =#f= properly Now =make-session= disables reading the default SSH configuration files when =#:config= is set to =#f= (as per Guile-SSH documentation.) Note that =#f= value is handled through the "process-config?" option that was added in libssh 0.9; when an older version of libssh is used, Guile-SSH falls back to setting the configuration file to =/dev/null= (which in turn prevents libssh from using the default configuration files.) When =#:config= is set to =#t= then the default SSH configuration files are read. This is by default to keep the backward compatibility. Reported by graywolf in ** session-func.c: Fix compile error caused by bool identifier :BUGFIX: Fix a compilation error caused by the confusion of a variable name with boolean type name. Reported and fixed by Peter Tillemans in ** session-func.c: Fix compilation with libssh < 0.8.3 :BUGFIX: Guile-SSH don't try to handle missing SSH_OPTIONS_PUBLICKEY_ACCEPTED_TYPES in libssh older than 0.8.3 because it leads to compilation errors. Instead now it issues a compilation warning. ** session-func.c: Add compilation warnings for missing options Now Guile-SSH issues compilation warnings for missing libssh session options. ** Drop support for libssh versions older than 0.8.0 :API_CHANGE: libssh 0.7.4 was released in 2017 and libssh 0.8.0 was released back in 2018 so it is quite old already. Since then some CVE were fixed, namely: - 0.8.4: CVE-2018-10933: libssh authentication bypass - 0.9.3: CVE-2019-14889: SCP: Unsanitized location leads to command execution - 0.9.4: CVE-2020-1730: Possible DoS in client and server when handling - 0.9.5: CVE-2020-16135: Avoid null pointer dereference in sftpserver (T232) - 0.9.6: CVE-2021-3634: Fix possible heap-buffer overflow when rekeying with different key exchange mechanism. Also libssh introduced some new features since 0.8.0 so Guile-SSH will not probably work with libssh 0.7 anyway. Guile-SSH with libssh 0.8 should work fine (according to tests) although some new Guile-SSH API will not be available (e.g. some types of private keys are not compatible with old versions of libssh.) Support for libssh version 0.8.0, 0.8.1 and 0.8.2 will be dropped in the next Guile-SSH releases. ** Documentation *** doc/api-popen.texi: Improve description; update examples *** doc/api-dist.texi: Fix the description of "make-node" *** doc/api-sessions.texi: Update and improve ** Tests *** tests/session.scm: Bugfix :BUGFIX: Set "host" to "example" so the default configuration from the test config will be read. *** tests/server.scm ("make-server", "server-get"): Bugfix :BUGFIX: Don't try to use DSA key when it is disabled. *** tests/common.scm: Don't use DSA keys when DSA is not supported :BUGFIX: *** tests/session: Expand "#:config" test suite *** tests/client-server: Fix logging :BUGFIX: In test case "data transferring, remote side abruptly closed": Don't log errors into stderr, use libssh log instead. Remove "error" word from the log string as surprisingly it tricks the test framework to think that some test error has happened. *** tests/client-server: Don't use ECDSA key with older versions of libssh :BUGFIX: Now test "userauth-public-key!, success") is skipped when libssh has version older than 0.8.3. Instead "userauth-public-key!, success (RSA)" test case is used for older versions of libssh. *** tests/sssh-ssshd: Don't use ECDSA keys with older versions of libssh :BUGFIX: ** Examples *** examples/ssshd.scm.in (main): Bugfix: Handle deprecation of DSA :BUGFIX: *** tests/key.scm: Bugfix: Handle DSA deprecation properly :BUGFIX: ** New simplified version of the project logo Thanks to Darya Sev. for very helpful design advices for the new simplified version of the project logo. ** New =CODE_OF_CONDUCT.org= file The document is a copy of converted into org-mode format. * Changes in version 0.17.0 (2024-05-01) ** =make-session= now loads config file before setting options =make-session= would always overwrite the explicitly set options passed by keywords with the values from the SSH configuration file. That lead to unexpected behavior. This patch fixes this error. Reported by graywolf in ** =session-set!= now allows to set =rsa-min-size= Only available if Guile-SSH is compiled with libssh 0.10. ** Add new tests. ** Update the documentation. * Changes in version 0.16.4 (2023-12-17) ** =private-key-from-file= now allows to read encrypted keys The procedure =private-key-from-file= from =(ssh key)= now has optional =#:auth-callback= and =#:user-data= keys that allow to specify a callback procedure to read the password for an encrypted key, and optionally pass to the callback procedure some user data. The Texinfo documentation for =private-key-from-file= is updated with an usage example. New tests were added for the new functionality. ** Add GNU Guix workflows for GitHub CI Now Guile-SSH has GNU Guix workflows for GitHub CI. Platforms: - x86_64-linux-gnu - aarch64-linux-gnu Thanks to Sharlatan Hellseher ** Fix typos in the documentation Some typos in =doc/api-popen.texi= are fixed, thanks to Maxim Cournoyer * Changes in version 0.16.3 (2023-01-29) ** Fix Guile-SSH/libssh channel leak Guile-SSH channel would always "leak" the libssh channels when the remote side issued the closing request. Now this bug is fixed by freeing libssh channel when the remote side is closed. Reported by Andrew Tropin in The test for reproducing the problem was provided by Ludovic Courtès . * Changes in version 0.16.2 (2023-01-02) ** Bugfix in test "string->public-key, ECDSA" The test used to explicitly compare libssh version with "9" so it would always fail on platforms with libssh 0.10. Now the test does numerical comparison and uses "ecdsa-p256" on platforms that have libssh 0.9 or later version. Reported by Vagrant Cascadian, here: * Changes in version 0.16.1 (2022-12-31) ** Disable the tests that require DSA algorithm by default When DSA support is disabled in libssh (which is the default state since libssh 0.10) all DSA-related Guile-SSH procedures will fail. Now Guile-SSH disables by default all the tests that are require the DSA algorithm support by default. Although those changes do not affect the Guile-SSH API directly, users should be aware that DSA support will be removed altogether in the next major libssh release. Reported by Vagrant Cascadian, here: ** Add '--enable-dsa' Autoconf option 'configure.ac' now has '--enable-dsa' option that allows to enable DSA public key algorithm support in Guile-SSH. ** (ssh version): 'dsa-support?': New procedure ** guix.scm: Use libssh 0.10.0 The development GNU Guix environment now uses libssh 0.10.0. * Changes in version 0.16.0 (2022-09-13) ** Fix Guile snarfer environment Fix a bug introduced in Guile-SSH 0.15.0 that breaks the cross-compilation. Reported by Ludovic Courtes here: ** New API: SFTP Directory Guile-SSH now allows directory traversal by means of the new procedures in the (ssh sftp) module. ** Update the documentation. * Changes in version 0.15.1 (2022-02-28) ** Fix session garbage collecting errors When a session is being destroyed by the Guile GC, the session garbage collector procedures try to close all the session channels. There was a bug that lead to accessing elements that are over the border of a channels list. Now the bug should be fixed. Reported by Ludovic Courtès in an email, here: ** Fix segfaults that occur on session closing When a remote side closing a channel Guile-SSH would fail as the libssh callback that marks the Guile-SSH channel as closed tried to convert a Guile channel object to the channel data and fails to do it. Now the problem should be fixed. Reported by Ludovic Courtès in an email, here: ** Add GNU Guix package definition to the repository Add =guix.scm= to the repository. The file contains GNU Guix package definition that allows to build Guile-SSH from Git. * Changes in version 0.15.0 (2022-01-03) ** Bump library version to "14:0:0" according to libtool rules In the 0.14.0 release of Guile-SSH the libtool library version wasn't properly changed. This could lead to compatibility problems. Now the version is bumped to "14:0:0". ** Remove requirement for 'whereis' command Guile-SSH required 'whereis' from 'util-linux' package to find 'guile-snarf' command. Now this dependency is removed. * Changes in version 0.14.0 (2021-12-20) ** API change: OpenSSH agent procedures are now in (ssh agent) Move agent procedures to (ssh agent) module from (ssh auth). The procedures are renamed and improved too. The current set of procedures provided by (ssh agent) is as follows: - ssh-agent-sock-get - ssh-agent-sock-set! - ssh-agent-start - ssh-agent-info The documentation is updated accordingly. ** API change: Remove 'sftp-init' from (ssh sftp) This procedure was not present in the module anyway, so this is more like a bugfix though. If you need to call SFTP init, you can use low-level '%sftp-init' procedure (although this is discouraged.) ** Guile-SSH channels are now explicitly blocking by default ** Fix snarfing errors on Fedora GNU/Linux Guile-SSH would fail to find 'guile-snarf' script on Fedora GNU/Linux when GNU Guile 2.2 installed because the snarfer installed as 'guile-snarf2.2'. Now the problem is fixed. ** Fix random segfaults due to libssh logging The library would sometimes get segfaults due to libssh logging. Guile-SSH used to pass Guile objects to a libssh logging procedure as a opaque pointers, and some Guile objects didn't make it to the point when an actual Scheme callback procedure called, GC'ted on the way. So when a Scheme logging callback tried to use its parameters, the parameters was freed already. Now Guile-SSH bypasses libssh logging altogether, calling a Scheme logging callback right away -- that provides more control over Scheme objects and allows to keep them from GC'ing. ** Fix "random" errors and segfaults in channels Guile-SSH would sometimes fail with segmentation faults and other errors when a remote side is abruptly closed the connection and the client side still tries to read data. Now in that situation reading a Guile-SSH channel results in EOF. ** Fix test failures due to 'primitive-fork' calls SRFI-64 doesn't really like tests that spawn new processes and try to do stuff after 'primitive-fork' without calling 'execle' (or similar) procedure: sometimes a test would fail even when all its test cases where successful. Now that should be fixed. ** Fix the tests for Guile 3.0.7 There are differences in REPL welcome message between Guile 3.0.7 and older versions. Now this difference is handled properly. Reported by Ludovic Courtès in ** Fix the tests for Guile 3.0.5 The test-runner object is now reset to #f when calling the 'test-end' procedure. See the commit de5d1a7f99b8e952b115237ebc29633062f99bb9 in Guile (srfi-64: Reset test-runner-current if done) which introduced this change. ** The Guile-SSH building process now less verbose ** Update documentation * Changes in version 0.13.1 (2020-08-19) ** Fix segfaults on GC'ing The library would always fail with segmentation fault when the GC tried to free Guile-SSH session when Guile-SSH channels related to this sessions were in use. Now live channels prevent the keep Guile-SSH session from freeing. ** Channels procedures now check if the parent session is alive Channels procedures now check if the parent session is alive and connected. If this is not the case, an guile-ssh-error is issued. * Changes in version 0.13.0 (2020-07-18) ** API change: 'call-with-ssh-forward' does not start a thread The procedure does not start a thread because multi-threading with libssh sometimes leads to random segfaults. Now 'call-with-ssh-forward' calls the provided procedure with a channel as an argument instead. If you wish to have a socket that forwards all the data to the remote side through an SSH channel, you should implement a separate process that forwards the data. There is an example in the directory 'examples/rpc' that shows how to implement such a forwarding. ** API change: add 'nodelay' option for Guile-SSH sessions Thanks to Lars-Dominik Braun. ** Fix some random segfaults in the channel and session code ** Add support for macOS Now Guile-SSH can be installed on macOS through a Homebrew Tap: https://github.com/aconchillo/homebrew-guile Thanks to Aleix Conchillo Flaqué! ** Disable libguile-ssh static library This change is a part of poring Guile-SSH to macOS. ** Don't use deprecated libssh procedures Add additional checks that replace deprecated procedures with the new ones when newer libssh library is present. ** Changes in documentation Fix Texinfo warnings. * Changes in version 0.12.0 (2020-01-05) ** API change: Implement new version of the RREPL API As proposed by Ludovic Courtès, this Guile-SSH version includes an implementation of a new stateless RREPL. ** New module: (ssh agent) The module contains procedures for interaction with running SSH agent instances. ** Prepare for Guile 2.9/3.0 Allow to build Guile-SSH with Guile versions 2.0, 2.2, 3.0. Pull request has been made by Ludovic Courtès in ** Remove bundled SRFI-64 This test framework is included in Guile since version 2.0.12. This request has been made by Ludovic Courtès in ** Cross-compilation support Now Guile-SSH should allow cross-compilation. Pull request has been made by Mathieu Othacehe in ** Changes in (ssh auth): *** New procedure 'userauth-gssapi!' The procedure allows to authenticate through GSSAPI (Generic Security Services Application Program Interface.) Pull request has been made by Lars-Dominik Braun in ** Generic compilation fixes Fix some warnings that surface during compilation and linking. ** Bugfixes *** Fix a segfault in 'libguile-ssh' The library would always fail with segmentation fault error when an application tried to free a closed channel. Now it should be fixed. Reported by Michael Bowcutt in and Njagi Mwaniki in a personal email. *** Fix building with libssh 0.8 The 'libguile-ssh' library would fail to build due to missing 'libssh_threads' library that was removed libssh 0.8. Now 'libguile-ssh' builds without 'libssh_threads' when using libssh 0.8+. Reported by lantw44 in *** Fix failing tests Tests would fail from time to time due to problems with an implementation of the Guile-SSH testing framework. Now Guile-SSH uses updated (and hopefully better) version of tests; that should fix most of the failures. Reported by Pilifer, Carl Dong and Vagrant Cascadian in * Changes in version 0.11.3 (2018-03-27) ** Bugfixes *** 'node-run-server' now checks for errors When 'node-run-server' fails to start the server it would go down an infinite loop. The procedure now checks if the RREPL server started correctly and throws 'node-error' if it's not. Reported by Marius Bakke and Ludovic Courtès, in * Changes in version 0.11.2 (2017-06-18) ** Bugfixes *** Always reset the channel and sftp streams when closing ports In Guile 2.2 objects (and thus Guile-SSH channels) are finalized in a separate finalizer thread, but libssh does not work properly in such a multi-threaded fashion -- which leads to segfaults in Guile-SSH. To address that problem the following changes are made: - In (ssh dist node) REPL channels opened in 'node-eval' are closed explicitly. - Channels and SFTP streams are always reset when closing ports. Thanks to Ludovic Courtès for the patches! Reported by Ludovic Courtès and Mark H Weaver, in *** In (ssh dist node) **** 'node-guile-version' now does not fail The procedure would always fail to get Guile version. Now that should be fixed. Reported by Mark H Weaver and Ludovic Courtès, in *** In (ssh session) **** 'session-set!' now throws an option with its value on an error *** In (ssh channel) **** Printing a channel now works with Guile 2.2 **** 'channel-get-exit-status' handle freed channels properly 'channel-get-exit-status' now handles freed channels properly by throwing 'wrong-type-arg' error. **** Printing a freed channel doesn't lead to SIGSEGV anymore Guile-SSH would always crash with SIGSEGV errors when tried to print a freed channel object (e.g. after calling 'close' on a channel). This bug is fixed now by introducing new checks. Now a freed channel will be printed like this: # ** Update unit tests *** Add test cases for fixed bugs ** Misc *** Improve logging * Changes in version 0.11.1 (2017-05-09) ** Bugfixes *** Fix building scripts The building process would always fail on fresh source tree because 'configure' tried to make a symlink or a copy of files that were not present yet. This should be fixed by now. Reported by Ludovic Courtès, on #guix IRC channel. * Changes in version 0.11.0 (2017-05-09) ** Add support of Guile 2.2 Tested with GNU Guile version 2.0.14 (on Gentoo GNU/Linux) and 2.2.2.3-0c102 (on Debian GNU/Linux.) Many thanks to Ludovic Courtès for patches! ** New module (ssh shell) The module provides some procedures build upon (ssh popen) module for working with remote shell. ** Bugfixes *** In (ssh tunnel) **** 'main-loop' now handles "interrupted system call" errors that sometimes occur on 'select' call. *** In (ssh dist node) ***** 'rrepl-get-result' now handles compilation errors The procedure would always fail to read compilation errors properly because it considered the message as "undefined" result. Now this bug should be fixed. An example of an error that now should be handled is "no code for module" due to using a non-existing module in 'with-ssh' expression. Reported by Mathieu, in ***** 'rrepl-get-result' now handles "unbound variable" errors The procedure would always fail to read "unbound variable" errors properly, returning wrong result with only two values (current module name and current language name). Now this bug should be fixed. Reported by Mathieu, in ***** 'rrepl-get-result' now handles unknown # objects The procedure would always fail to read unknown objects (e.g. instances of Guile-SSH session) properly, raising an obscure errors like "Unknown # object: #\<". Now the procedure raises 'node-repl-error' with full evaluation result gotten from RREPL. Reported by Mathieu, in ** Changes in (ssh dist node) *** 'node-eval' now can work without procps The procedure now checks if procps package is present on a node and uses fallback Guile-SSH implementation of 'pgrep' and 'pkill' if it is not. The fallback implementation of 'pgrep' is built upon pure bash, and 'pkill' in addition requires Guile itself on the remote side. *** New procedure 'node-loadavg' The procedure can be used to get average load of a node. ** Changes in (ssh dist) Procedures in the module now are capable of checking presence of procps package on a remote side and switching to fallback implementation of some of the procps tools when the package is not present -- thanks to updated 'node-eval' procedure (see above.) At the end of the day it means that now the code can start/stop Guile REPL server on a remote side even without procps installed. ** Update unit tests *** Add test cases for (ssh shell) module ** Update documentation *** Add documentation for (ssh shell) module *** Describe project goals in "Introduction" section * Changes in version 0.10.2 (2016-11-25) ** New procedures *** New procedure 'channel-send-eof' in (ssh channel) The procedure allows to send end-of-file (EOF) on a channel. This action doesn't close the channel; you may still read from it but not write. 'channel-send-eof!' is handy when we deal with a remote command that reads data until EOF (such as 'wc'.) ** Documentation *** Add procedure index ** Misc *** Fixed several compilation warnings * Changes in version 0.10.1 (2016-10-09) ** Bugfixes *** Fix SMOB freeing callbacks Callbacks for many Guile-SSH objects would always fail to free allocated resources due to wrong check added in 0.10.0. The problem should be fixed now. ** Change default 'guilesitedir' to 'PREFIX/share/guile/site/X.Y' from 'PREFIX/share/guile-ssh/ssh/' * Changes in version 0.10.0 (2016-08-20) ** Add support of Guile 2.0.12 Guile-SSH now builds (and works quite well, as far as I can see) with Guile 2.0.9 and 2.0.12. Unit tests are passing too. Tested on: - Gentoo GNU/Linux, Guile 2.0.12-r1, libssh 0.7.3 - Gentoo GNU/Linux, Guile 2.0.9-r1, libssh 0.7.3 ** Add support of libssh 0.7.3 Guile-SSH now supports libssh 0.7.3 and (probably) newer versions; haven't tested. Note that [[https://www.libssh.org/2016/02/23/libssh-0-7-3-security-and-bugfix-release/][CVE-2016-0739 was found in previous libssh versions]]; though you may still use 0.6.4, you really should stick with 0.7.3+ for aforementioned reason. 0.7.3 is already should be in your distro's repository, so that won't be a big deal I guess. ** Bugfixes *** (ssh dist node) **** 'node-server-running?' now checks the default port The procedure now checks for Guile server running on the default port (that is, with '--listen' option without an argument), if that port was specified for the node. *** Fix include errors and misspecified inline procedures in C code These errors lead to build failures (reported on Arch GNU/Linux, see .) *** Don't merge stderr with stdout in remote pipes See . ** Examples *** Add 'uptop' example ** Update documentation ** Unit tests Expand test suite, improve existing tests. Namely tests now don't always fail when '-j' option is used with 'make check', with value greater than 1 (e.g. '-j4'; tested on Gentoo GNU/Linux, 4-core Intel Atom CPU) Though sometimes tests fail, so there's still a room for improvement. Another improvement is that SRFI-64 module and Guile-SSH common test module are now compiled before use, that should speed up the tests. * Changes in version 0.9.0 (2015-12-24) ** Bugfixes *** Fix a bug in distributed forms in handling of REPL errors Distributed procedures now throw an 'node-repl-error' on an evaluation error instead of returning of an unspecified value. *** Fix a bug in handling of strings in distributed forms The 'rrepl-eval' was always failing to send sexps that contain strings in the proper way because the procedure uses the human-readable printing to transmit the data. As the result an RREPL fails to evaluate it and reports an error. The bug is fixed by switching to the machine-readable data printing. *** 'dist-map' and 'distribute' now raise an error if an evaluation failed instead of silently return an empty list. *** 'channel-listen-forward' now returns a correct port number 'channel-listen-forward' would always return garbage as the 2nd argument when called with port > 0. Now when the port is explicitly specified then the procedure returns the specified port as the 2nd argument. *** Add missing export of 'node-tunnel' from (ssh dist node) module ** Changes in API *** Distributed forms now return the number of evaluation as a number instead of string. *** 'with-ssh' is now capable of handling of multiple values 'with-ssh' now returns a vector of values if an expression was evaluated to multiple values. 'distribute' and 'dist-map' only take the 1st value if multiple values were returned by an expression. *** Nodes are now capable of starting and stopping a remote REPL (RREPL) The new behaviour is controlled by 'start-repl-server?' and 'stop-repl-server?' keyed options of 'make-node'. Stopping of a RREPL server is disabled by default. *** Channels now can be created as input, output or bi-drectional ports The direction of a channel is controlled by the 2nd argument to 'make-channel' procedure. *** 'make-session' now takes 'config' option that allows to specify whether the SSH config should be parsed or not, and optionally the path to the config. ** New procedures *** New procedure 'node-server-running?' in (ssh dist node) *** New procedure 'node-run-server' in (ssh dist node) *** New procedure 'node-stop-server' in (ssh dist node) *** New procedure 'node-guile-version' in (ssh dist node) *** New procedure 'session-parse-config!' in (ssh session) ** New modules *** (ssh popen) Remote popen interface to interact with remote processes. *** (ssh sftp) SFTP interface that allows to operate on remote files. ** Documentation *** Move description of tunnels into a separate section *** Add description of the new procedures *** Update existing documentation ** Unit tests *** Expand the test suite for distributed forms *** Expand the test suite for tunnels ** Add the project logo * Changes in version 0.8.0 (2015-08-04) ** Implement port forwarding ** Add distributed forms ** Require libssh 0.6.4 or 0.6.5 ** New module: (ssh tunnel) The module provides hi-level procedures for SSH tunneling. ** New module: (ssh dist) The module provides distributed forms of 'map' and 'eval', as well as remote REPL (RREPL) implementation. ** New module: (ssh dist job) Low-level API for distributed jobs. ** New module: (ssh dist node) Low-level API for distributed nodes. ** New procedure 'channel-accept-forward' in (ssh channel) ** New procedure 'channel-listen-forward' in (ssh channel) ** Remove 'channel-open-forward/reverse' procedure from (ssh channel) ** Examples *** Add an RPC client example Add an example program that does an RPC call over a secure channel using a Guile-SSH tunnel. See 'examples/rpc' directory. *** Add a RREPL example Add a demo program that connects to a remote REPL (RREPL). ** Update documentation * Changes in version 0.7.2 (2015-02-24) ** Remove dependency on libgcrypt added by a mistake ** Fix "double free or corruption" error on GC'ing of keys Fix "double free or corruption" error that occures in case when a key was derived from an authentication message by means of `message-get-req'. When such a key is GC'ed then GC'ing of its parent message leads to error, or vice versa. ** Fix a bug in the channel implementation The bug could occasionally manifest itself on channel reading as the following error: #+BEGIN_EXAMPLE guile: ports.c:1476: scm_i_fill_input: Assertion `pt->read_pos == pt->read_end' failed. #+END_EXAMPLE ** New `server-get' procedure in (ssh server) The procedure can be used to retrieve server options. ** New `channel-get-exit-status' procedure in (ssh channel) The procedure allows to get exit status of an executed command from a channel. ** New `channel-request-send-exit-status' procedure in (ssh channel) The procedure can be used to send the exit status to a client. ** Improve printing of Guile-SSH server objects Print the bind address of a server object and its bind port. Example: #+BEGIN_EXAMPLE # #+END_EXAMPLE ** Update examples *** sssh - Check exit status of an executed command. *** ssshd - Send exit status to the client according to the result of command execution. *** echo server and client - Some cosmetic changes aimed to make the code cleaner. ** Update documentation - Add description of the new procedures. - Update examples. * Changes in version 0.7.1 (2014-10-11) ** New `%get-libssh-version' procedure in (ssh version) The procedure can be used to get libssh version in the "raw" format such as: "0.6.3/openssl/zlib". ** New `get-crypto-library' procedure in (ssh version) The procedure returns name of a cryptographic library with which libssh was compiled. ** New `zlib-support?' procedure in (ssh version) The procedure checks if zlib support is enabled in libssh. ** New `set-log-verbosity!' procedure in (ssh log) The procedure sets global libssh log verbosity. ** New `get-log-verbosity' procedure in (ssh log) The procedure gets global libssh log verbosity. ** New `make-keypair' procedure in (ssh key) The procedure can be used to generate a new keypair with the specified parameters. ** New `private-key-to-file' procedure in (ssh key) The procedure can be used to export a private key to a file (doesn't work if libssh 0.6.3 is compiled with GCrypt). ** Changes in tests *** Fix "end of file" errors in tests Fix the following kind of errors in tests: #+BEGIN_EXAMPLE ERROR: In procedure scm_i_lreadparen: /path/to/guile-ssh/sources/tests/./client-server.scm:272:34: end of file #+END_EXAMPLE Thanks to Ludovic Courtès for reporting the issue and for a good advice how to fix that. *** Don't perform ECDSA key tests if libssh is compiled with GCrypt libssh 0.6.3 does not support ECDSA keys if compiled with GCrypt instead of OpenSSL. Thus, ECDSA key tests used to fail. Now there is a check that prevents these tests from execution in case when libssh 0.6.3 is compiled with GCrypt. ** Update documentation - Add description of the new procedures. - Add note about ECDSA keys support with GCrypt library. * Changes in version 0.7.0 (2014-08-31) ** Require GNU Guile 2.0 ** Require libssh 0.6.3 ** Change `get-public-key-hash' *** Move the procedure to (ssh key) *** Return the hash as a bytevector *** Accept a public key as the first argument *** Accept a hash type as the second argument Possible types are: 'md5, 'sha1 ** (ssh auth) procedures now throw an exception if the session is not connected ** (ssh channel) procedures now handle closed and freed channels - `channel-open?' returns `#f' if the channel has been closed freed. - `channel-open-session' and `channel-eof?' throw to `guile-ssh-error' if the channel has been closed and freed. - `channel-request-env', `channel-request-exec', `channel-request-pty', `channel-request-shell', `channel-set-pty-size!', `channel-set-stream!', `channel-get-stream' now throw `wrong-type-arg` if the channel is closed. ** Some (ssh session) procedures now throw an exception if the session is not connected These procedures are: - `get-protocol-version' - `authenticate-server' - `get-server-public-key' - `write-known-host!' ** Change `userauth-pubkey!' *** Rename it to `userauth-public-key!' *** Change arguments ** `blocking-flush!' now returns `error' symbol on error instead of throwing of an exception ** `connect!' now returns `error' symbol on error instead of throwing of an exception ** `authenticate-server' now returns `error' symbol on error instead of throwing of an exception ** `private-key-from-file' now takes only a file name ** New (ssh log) module ** Rename `userauth-pubkey-auto!' to `userauth-public-key/auto!' ** New `userauth-public-key/try' procedure in (ssh auth) ** New `bytevector->hex-string' procedure in (ssh key) ** New `channel-open-forward' procedure in (ssh channel) ** New `channel-open-forward/reverse' procedure in (ssh channel) ** New `session-get' procedure in (ssh session) ** New `channel-get-session' procedure in (ssh channel) ** New `message-get-session' procedure in (ssh message) ** Improve printing of Guile-SSH objects *** Print more detailed information about `session' object Print user name, host name and current state of a `session' object. *** Print object address for `channel' object *** Print object address for `message' object *** Print object address for `key' object ** Changes in tests *** Add tests for Guile-SSH keys *** Add tests for `authenticate-server' procedure ** Bug fixes *** Fix a GC issue Keep a reference to the parent session in channels and messages to prevent the session from premature GC'ing. Without that GC could free a session even if there are live channels and by that break the channels. *** `public-key?' and `private-key?' now produce correct result Functions now return `#f' if the given argument is not a Guile-SSH key object. ** Documentation update *** Fix old URLs to Guile-SSH repository in the `Installation' chapter *** Add an overview of programming with Guile-SSH to the "Examples" chapter * Changes in version 0.6.0 (2014-03-23) ** Remove username from parameter list of auth procedures `userauth-password!' and `userauth-pubkey!' don't take a username as a parameter anymore. Rationale: According to libssh 0.6 docs, most server implementations do not permit changing the username during authentication. Moreover, the parameter was deprecated in libssh 0.5.3. Elimination of the username makes Guile-SSH Auth API clearer and simpler. Username can be set either on creation of a session or by calling of `session-set!' procedure. ** `server-accept' now throws `guile-ssh-error' on error ** Improve reads from channels Return EOF immediately if the channel is closed instead of polling it for data (which causes notable latency on the first read). Thanks Ludovic Courtès for the patch. ** Compile Guile modules Compile Guile modules and install compiled files if GNU Guile 2.0.x is available. ** Update Texinfo documentation *** Update Auth API description *** Update Server API description *** Update Acknowledgments ** Update examples *** Use actual path to Guile interpreter in the shebang Executables will be produced during building of the Guile-SSH. *** Handle `guile-ssh-error' on `server-accept' *** Catch `guile-ssh-error' on reading from a port *** ssshd **** Add `--port', `--ssh-debug' and `--pid-file' option **** Store the PID in a file instead of printing it to stdout. **** Handle password authentication correctly *** sssh **** Add `--ssh-debug' option ** Improve automated tests *** Prevent sssh-ssshd from asking of a SSH agent for keys *** Make parallel tests work * Changes in version 0.5.0 (2014-02-05) ** Implement Guile-SSH channels as GNU Guile ports. Now channels can be used with regular procedures such as `display', `write' and `read-line'. ** `session-set!' and `server-set!' now take log-verbosity as a symbol Use symbols to represent log levels instead of numbers. ** Remove duplicates of some session options Remove duplicates that are existed for some Guile-SSH session options: `port-str' (duplicates `port', differs only in expected type of value), `log-verbosity-str' (duplicates `log-verbosity', differs only in expected type of value), `add-identity' (duplicates `identity', no differences). ** New `userauth-autopubkey!' procedure. The procedure can be used for public key authentication with a SSH agent. ** New procedures. `channel-set-stream!', `channel-get-stream', `session?', `server?', `message?'. ** Remove procedures. These procedures are removed due to changes in Guile-SSH channel API: `close-channel!', `channel-poll' `free-channel!', `channel-read`, `channel-write'. ** Add documentation in Texinfo format The Guile-SSH reference manual in Info format will be installed on `make install' into `${prefix}/share/info' directory. ** Update sssh/ssshd example. *** `examples/sssh.scm' and `examples/ssshd.scm' are updated to use the new Guile-SSH channel API. *** `sssh.scm` now uses `userauth-autopubkey!' *** `ssshd.scm' now parses command-line options See `ssshd.scm --help'. ** Add echo server/client example. See `examples/echo' directory. ** Add automated tests. See `tests/' directory. * Changes in version 0.4.0 (2013-11-26) ** Port the library to GNU Guile version 2.0 Now the library works with GNU Guile version 2.0 as well as 1.8. ** Remove "ssh:" prefix from procedures names. If it is needed, an user's prefix can be added by setting a renamer for a module on loading. See the documentation for the GNU Guile module system. ** Implement basic SSH server API. ** Fix a memory corruption in `channel-read' The problem was seen on reading of an output from "lsb_release -a" command. ** Fix a memory corruption during GC'ing of SSH keys. ** Fix a bug in `session-set!' Fix the bug that leads to an error if the user tried to set a correct boolean option. ** New `channel-write' procedure. ** New `channel-request-pty' procedure. ** New `channel-request-shell' procedure. ** New `channel-set-pty-size!' procedure. ** Fix the name of `write-known-host!' The procedure was called `authenticate-server' by mistake. Rename it to `write-known-host!'. ** Change error handling in some procedures. Now `write-known-host!', `channel-open-session', `channel-request-exec', `channel-request-env', `close-channel!', throw an exception on error. The return value of these procedures now is undefined. ** `authenticate-server' now throws guile-ssh-error exception on error. Don't return the 'error symbol, throw an exception instead. ** `server-set!' now throws guile-ssh-error exception on error. The return value now is undefined. ** Rename `make-session' to `%make-session'. See `make-session' below. ** New `make-session' procedure. This is a convenient wrapper for `%make-session' which allows to set session options by passing them as keywords. ** Rename `connect' to `connect!'. ** Fix a typo in an option symbol 'strcthostkeycheck -> 'stricthostkeycheck ** Fix an infinite loop in `public-key->string'. The problem was observed on Ubuntu GNU/Linux 10.04 LTS. ** Add examples to the repository. See the "examples/" directory. ** Improve printing of SSH keys, channels and messages. Examples: #, # * Changes in version 0.3.1 (2013-07-14) ** Use a simpler method to GC'ing of SSH channels. The idea is that we don't have to free resources allocated by a channel during its GC'ing, because these resources will be freed anyway when the related SSH session is GC'ed. However, to be able to control allocating of resources more precisely, introduce new procedure ssh:free-channel! that can be used for freeing resources allocated by a channel. ** ssh:free-channel! New procedure. ** Make the library thread-safe. * Changes in version 0.3 (2013-07-13) ** Improve working with public keys. Because some libssh functions are working with public keys represented as a ssh_string instead of a ssh_public_key, we try to hide this peculiarity so all kinds of keys are look like a class from the Scheme perspective. ** Fix segmentation faults on GC'ing of SSH objects. The program doesn't crashes anymore during GC'ing of SSH objecs. ** ssh:public-key-from-file Make it work. Return newly created instance or #f on error. ** ssh:public-key->string Take a key as a instance. ** ssh:private-key-from-file Fix call to an undefined procedure. Return #f on error. ** ssh:get-key-type New procedure. The procedure returns type for a passed instance. Possible types are: 'dss, 'rsa, 'rsa1, 'unknown ** ssh:userauth-get-list New procedure. The procedure returns a list of available authentication methods for a given SSH session ** ssh:channel-read Fix call to an undefined procedure. Throw guile-ssh-error exception on error. ** ssh:close-channel! Fix return value: return #t if channel is closed successfully, #f otherwise. ** ssh:blocking-flush! Return 'error by default. ** ssh:session-set! Fix a bug with uint32 options setting. ** SSH objects now comparable. * Changes in version 0.2 (2013-05-25) ** Release of the first stable version of Guile-SSH. Local Variables: mode: org End: guile-ssh-0.18.0/README000066400000000000000000000166051471416131000143660ustar00rootroot00000000000000# -*- mode: org; -*- [[./doc/logo-v2.png]] Guile-SSH is a library that provides access to the [[https://en.wikipedia.org/wiki/Secure_Shell][SSH protocol]] for programs written in [[https://www.gnu.org/software/guile/][GNU Guile]] interpreter. It is built upon the [[https://www.libssh.org/][libssh]] library. [[https://github.com/artyom-poptsov/guile-ssh/actions/workflows/guile2.2.yml][https://github.com/artyom-poptsov/guile-ssh/actions/workflows/guile2.2.yml/badge.svg]] [[https://github.com/artyom-poptsov/guile-ssh/actions/workflows/guile3.0.yml][https://github.com/artyom-poptsov/guile-ssh/actions/workflows/guile3.0.yml/badge.svg]] [[https://github.com/artyom-poptsov/guile-ssh/actions/workflows/fedora.yml][https://github.com/artyom-poptsov/guile-ssh/actions/workflows/fedora.yml/badge.svg]] [[https://github.com/artyom-poptsov/guile-ssh/actions/workflows/guix.yml][https://github.com/artyom-poptsov/guile-ssh/actions/workflows/guix.yml/badge.svg]] * Features - The API that is sufficient for building of standalone SSH clients and servers, or for embedding client/server functionality in your lispy Scheme applications. - Several authentication methods are supported, including password authentication, public key and SSH agent authentication methods. - Key management procedures: you can make key pairs, read keys from files, get key hashes, get public keys from private keys etc. DSS (only when =--enable-dsa= option is passed to the =configure= script), RSA, RSA1 and ECDSA (by means of OpenSSL) are supported. - Port forwarding procedures and high-level API for creating of SSH tunnels. - Distributed forms (=dist-map=, =distribute=, ...) that allow to spread the evaluation of Scheme code between remote hosts. Or you can just connect to a remote REPL from Scheme using =with-ssh= procedure and evaluate some expressions. No special server needed on the remote side, just an SSH daemon and GNU Guile installed! - SFTP client API allows you to read and write remote files, or do directory traversal over the SSH protocol right from the Scheme code. - Remote popen API that allows you to make either input, output or bidirectional pipes to remote processes. - Detailed documentation in Texinfo format with examples included, even more examples in =examples= directory. * License Guile-SSH 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 3 of the License, or (at your option) any later version. Please see =COPYING= file for the terms of GNU General Public License. The logo (=doc/logo.svg=, =doc/logo-with-text.svg= and rasterised versions) is distributed under terms of [[https://creativecommons.org/licenses/by-sa/4.0/][Creative Commons Attribution-ShareAlike 4.0 International]]. * Requirements - [[https://www.gnu.org/software/guile/][GNU Guile]], version 2.0.12 or later (known to work with 2.0.12, 2.0.14, 2.2.4, 3.0.1) - [[http://www.libssh.org/][libssh]], version 0.8.0 or later. * Distribution Files: - AUTHORS contains list of people who contributed to the library development. - COPYING contains the terms of GNU General Public License. - INSTALL contains general instructions for building/installing of Guile-SSH. - NEWS describes user-visible changes. - TODO contains plans for the further development and list of known bugs. Directories: - examples -- Examples of Guile-SSH usage. - libguile-ssh -- Sources of the Guile-SSH library. - modules -- Scheme modules. - doc -- Documentation in Texinfo format. - tests -- Unit tests. Files are usually installed according to the prefix specified to =configure= script, =/usr/local= by default. Building and installing gives you: Libraries, in =${prefix}/lib=: - libguile-ssh.so. - libguile-ssh.la - libguile-ssh.a Guile modules, in =${GUILE_SITE}/ssh=: - auth.scm -- User authentication. - agent.scm -- Interaction with SSH authentication agent instances. - channel.scm -- Channel manipulation. - dist.scm -- Distributed forms. - dist/job.scm -- Low-level distributed job API. - dist/node.scm -- Low-level distributed node API. - key.scm -- Keys management. - log.scm -- Interface to libssh logging facilities - message.scm -- Procedures for working with SSH messages. - popen.scm -- Remote popen API. - server.scm -- Server API. - session.scm -- Session management. - sftp.scm -- SFTP client API. - shell.scm -- High-level API to a remote shell. - tunnel.scm -- SSH tunnels. - version.scm -- Information about versions. All the modules will be compiled and produced .go files will be installed to =site-ccache= directory which is something like this: =${libdir}/guile/2.0/site-ccache/ssh/=. Documentation in Info format, in =${prefix}/share/info/=: - guile-ssh.info Examples, in =${prefix}/share/guile-ssh/examples=: - ssshd.scm -- SSH server example. - sssh.scm -- SSH client example. + echo/ - client.scm -- Echo client example. - server.scm -- Echo server example. + rpc/ - client.scm -- A simple Guile-RPC client that makes an RPC call over a Guile-SSH tunnel. - server.scm -- A simple Guile-RPC server. - rrepl.scm -- Remote REPL example. - sscp.scm -- Scheme secure copy. - pg-tunnel.scm -- Connect to a PostgreSQL instance through an SSH tunnel. - uptop.scm -- Uppercase =top=, through a remote pipe. * Installation The library can be installed by the following means: - Using GNU Guix: https://www.gnu.org/software/guix/ - Using Arch GNU/Linux AUR package: https://aur.archlinux.org/packages/guile-ssh/ - Using Parabola GNU/Linux package: https://www.parabola.nu/packages/?q=guile-ssh - Using openSUSE GNU/Linux package: https://software.opensuse.org/package/guile-ssh - Using a Homebrew Tap on macOS (thanks to Aleix Conchillo Flaqué): https://github.com/aconchillo/homebrew-guile - Manually. If you're considering manual installation, see the notes below. Thanks for all the people who helped with packaging of Guile-SSH! Also there is a [[https://hub.docker.com/r/avvp/debian-guile/][Docker image]] based on Debian GNU/Linux that contains the latest version of GNU Guile and Guile-SSH installed -- give it a try! For a basic explanation of the installation of the package, see the INSTALL file. But to make the long story short, you can try run the following in the project directory -- those commands will configure, build, check and install Guile-SSH in your system: #+BEGIN_EXAMPLE $ autoreconf -vif $ ./configure $ make $ make check $ make install #+END_EXAMPLE Please *note* that you will need [[https://www.gnu.org/software/automake/][Automake]] 1.12 or later to run self-tests with =make check= (although the library itself can be built with older Automake version such as 1.11, just leave out the =make check= step). *important* You probably want to call configure with the =--with-guilesitedir= option so that this package is installed in Guile's default path. But, if you don't know where your Guile site directory is, run =configure= without the option, and it will give you a suggestion. * Usage Please see the documentation in Info format for API documentation and usage examples -- you can open it by typing =info guile-ssh= in the shell, or using =C-h i m guile-ssh RET= combo in Emacs. Also take a look on examples in the =examples= directory. guile-ssh-0.18.0/README.org000077700000000000000000000000001471416131000161542./READMEustar00rootroot00000000000000guile-ssh-0.18.0/THANKS000066400000000000000000000016661471416131000144220ustar00rootroot00000000000000Guile-SSH has originally been written by Artyom V. Poptsov. The libssh that is used by Guile-SSH is initially written by Aris Adamantiadis and being developed by the developer community. See AUTHORS file that comes along with libssh distribution for full authors list. Thanks to the following people who contributed to Guile-SSH through bug reports or patches: * Aleix Conchillo Flaqué * Andrew Tropin * David Kastrup * David Thompson * Ludovic Courtès * SaffronSnail * Mathieu Othacehe * Marius Bakke * Ting-Wei Lan * Lars-Dominik Braun * Sharlatan Hellseher * Maxim Cournoyer * graywolf * Darya S. * Peter Tillemans Thank you.guile-ssh-0.18.0/TODO000066400000000000000000000016211471416131000141660ustar00rootroot00000000000000-*- Mode: Outline -*- * Ideas ** Make channel buffers configurable. ** Make use of libssh callbacks to track asynchronous events on channels ** DONE Use more robust approach to evaluate Lisp code on a remote side Quoting Ludovic Courtès, "[...] it might be best to not use the REPL at all. In the Shepherd I used a simple protocol whereby the sexp to evaluate is passed to the other process, which returns an sexp denoting success and a list of return values, or failure and an exception. That way you don’t have to “parse” anything; you just get a clear description of the return values or the exception that you got." Food for thought. GNU Shepherd: https://www.gnu.org/software/shepherd/ ** Allow to specify the load coefficient for each node in (ssh dist node) ** 'dist-load' procedure that allows to load a local Scheme program on specified host(s). * Known Bugs guile-ssh-0.18.0/build-aux/000077500000000000000000000000001471416131000153705ustar00rootroot00000000000000guile-ssh-0.18.0/build-aux/.gitignore000066400000000000000000000001651471416131000173620ustar00rootroot00000000000000# -*- shell-script -*- config.guess config.sub depcomp install-sh ltmain.sh mdate-sh missing test-driver texinfo.texguile-ssh-0.18.0/build-aux/Makefile.am000066400000000000000000000000301471416131000174150ustar00rootroot00000000000000# empty SUBDIRS = am m4 guile-ssh-0.18.0/build-aux/am/000077500000000000000000000000001471416131000157655ustar00rootroot00000000000000guile-ssh-0.18.0/build-aux/am/Makefile.am000066400000000000000000000015671471416131000200320ustar00rootroot00000000000000## Config file for GNU Automake. ## ## Copyright (C) 2014 Artyom V. Poptsov ## ## This file is part of Guile-SSH. ## ## Guile-SSH 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 3 of the ## License, or (at your option) any later version. ## ## Guile-SSH 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 Guile-SSH. If not, see . AUTOMAKE_OPTIONS = gnu am_frags = guilec guile.am EXTRA_DIST = $(am_frags) ## Makefile.am ends here guile-ssh-0.18.0/build-aux/am/guile.am000066400000000000000000000027561471416131000174230ustar00rootroot00000000000000include $(top_srcdir)/build-aux/am/guilec if CROSS_COMPILING CROSS_COMPILING_VARIABLE = GUILE_SSH_CROSS_COMPILING=yes else CROSS_COMPILING_VARIABLE = endif GOBJECTS = $(SOURCES:%.scm=%.go) nobase_mod_DATA = $(SOURCES) $(NOCOMP_SOURCES) nobase_go_DATA = $(GOBJECTS) # Make sure source files are installed first, so that the mtime of # installed compiled files is greater than that of installed source # files. See # # for details. guile_install_go_files = install-nobase_goDATA $(guile_install_go_files): install-nobase_modDATA CLEANFILES = $(GOBJECTS) $(GOBJECTS): $(lib_LTLIBRARIES) # Build the library first EXTRA_DIST = $(SOURCES) $(NOCOMP_SOURCES) GUILE_WARNINGS = \ -Wunbound-variable \ -Warity-mismatch \ -Wunused-variable \ -Wunused-toplevel \ -Wformat # TODO: Move environment setup to a separate file. guilec_env = \ GUILE_AUTO_COMPILE=0 \ $(CROSS_COMPILING_VARIABLE) \ GUILE_SYSTEM_EXTENSIONS_PATH="$(abs_top_builddir)/libguile-ssh/.libs/:${GUILE_SYSTEM_EXTENSIONS_PATH}" \ GUILE_LOAD_PATH="$(abs_top_srcdir)/modules" \ GUILE_LOAD_COMPILED_PATH="$(builddir)/ssh:$$GUILE_LOAD_COMPILED_PATH" guilec_opts = \ --load-path=$(abs_srcdir)/modules \ --load-path=$(abs_builddir)/modules \ --target=$(host) \ $(GUILE_WARNINGS) .scm.go: $(AM_V_GUILEC)$(guilec_env) $(GUILEC) $(guilec_opts) \ --output=$@ $< clean-go: -$(RM) $(GOBJECTS) .PHONY: clean-go guile-ssh-0.18.0/build-aux/am/guilec000066400000000000000000000002561471416131000171630ustar00rootroot00000000000000# -*- makefile -*- GUILEC = $(GUILD) compile AM_V_GUILEC = $(AM_V_GUILEC_$(V)) AM_V_GUILEC_ = $(AM_V_GUILEC_$(AM_DEFAULT_VERBOSITY)) AM_V_GUILEC_0 = @echo " GUILEC " $@; guile-ssh-0.18.0/build-aux/compile000077500000000000000000000163471471416131000167610ustar00rootroot00000000000000#!/bin/sh # Wrapper for compilers which do not understand '-c -o'. scriptversion=2018-03-07.03; # UTC # Copyright (C) 1999-2021 Free Software Foundation, Inc. # Written by Tom Tromey . # # 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, 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, see . # As a special exception to the GNU General Public License, if you # distribute this file as part of a program that contains a # configuration script generated by Autoconf, you may include it under # the same distribution terms that you use for the rest of that program. # This file is maintained in Automake, please report # bugs to or send patches to # . nl=' ' # We need space, tab and new line, in precisely that order. Quoting is # there to prevent tools from complaining about whitespace usage. IFS=" "" $nl" file_conv= # func_file_conv build_file lazy # Convert a $build file to $host form and store it in $file # Currently only supports Windows hosts. If the determined conversion # type is listed in (the comma separated) LAZY, no conversion will # take place. func_file_conv () { file=$1 case $file in / | /[!/]*) # absolute file, and not a UNC file if test -z "$file_conv"; then # lazily determine how to convert abs files case `uname -s` in MINGW*) file_conv=mingw ;; CYGWIN* | MSYS*) file_conv=cygwin ;; *) file_conv=wine ;; esac fi case $file_conv/,$2, in *,$file_conv,*) ;; mingw/*) file=`cmd //C echo "$file " | sed -e 's/"\(.*\) " *$/\1/'` ;; cygwin/* | msys/*) file=`cygpath -m "$file" || echo "$file"` ;; wine/*) file=`winepath -w "$file" || echo "$file"` ;; esac ;; esac } # func_cl_dashL linkdir # Make cl look for libraries in LINKDIR func_cl_dashL () { func_file_conv "$1" if test -z "$lib_path"; then lib_path=$file else lib_path="$lib_path;$file" fi linker_opts="$linker_opts -LIBPATH:$file" } # func_cl_dashl library # Do a library search-path lookup for cl func_cl_dashl () { lib=$1 found=no save_IFS=$IFS IFS=';' for dir in $lib_path $LIB do IFS=$save_IFS if $shared && test -f "$dir/$lib.dll.lib"; then found=yes lib=$dir/$lib.dll.lib break fi if test -f "$dir/$lib.lib"; then found=yes lib=$dir/$lib.lib break fi if test -f "$dir/lib$lib.a"; then found=yes lib=$dir/lib$lib.a break fi done IFS=$save_IFS if test "$found" != yes; then lib=$lib.lib fi } # func_cl_wrapper cl arg... # Adjust compile command to suit cl func_cl_wrapper () { # Assume a capable shell lib_path= shared=: linker_opts= for arg do if test -n "$eat"; then eat= else case $1 in -o) # configure might choose to run compile as 'compile cc -o foo foo.c'. eat=1 case $2 in *.o | *.[oO][bB][jJ]) func_file_conv "$2" set x "$@" -Fo"$file" shift ;; *) func_file_conv "$2" set x "$@" -Fe"$file" shift ;; esac ;; -I) eat=1 func_file_conv "$2" mingw set x "$@" -I"$file" shift ;; -I*) func_file_conv "${1#-I}" mingw set x "$@" -I"$file" shift ;; -l) eat=1 func_cl_dashl "$2" set x "$@" "$lib" shift ;; -l*) func_cl_dashl "${1#-l}" set x "$@" "$lib" shift ;; -L) eat=1 func_cl_dashL "$2" ;; -L*) func_cl_dashL "${1#-L}" ;; -static) shared=false ;; -Wl,*) arg=${1#-Wl,} save_ifs="$IFS"; IFS=',' for flag in $arg; do IFS="$save_ifs" linker_opts="$linker_opts $flag" done IFS="$save_ifs" ;; -Xlinker) eat=1 linker_opts="$linker_opts $2" ;; -*) set x "$@" "$1" shift ;; *.cc | *.CC | *.cxx | *.CXX | *.[cC]++) func_file_conv "$1" set x "$@" -Tp"$file" shift ;; *.c | *.cpp | *.CPP | *.lib | *.LIB | *.Lib | *.OBJ | *.obj | *.[oO]) func_file_conv "$1" mingw set x "$@" "$file" shift ;; *) set x "$@" "$1" shift ;; esac fi shift done if test -n "$linker_opts"; then linker_opts="-link$linker_opts" fi exec "$@" $linker_opts exit 1 } eat= case $1 in '') echo "$0: No command. Try '$0 --help' for more information." 1>&2 exit 1; ;; -h | --h*) cat <<\EOF Usage: compile [--help] [--version] PROGRAM [ARGS] Wrapper for compilers which do not understand '-c -o'. Remove '-o dest.o' from ARGS, run PROGRAM with the remaining arguments, and rename the output as expected. If you are trying to build a whole package this is not the right script to run: please start by reading the file 'INSTALL'. Report bugs to . EOF exit $? ;; -v | --v*) echo "compile $scriptversion" exit $? ;; cl | *[/\\]cl | cl.exe | *[/\\]cl.exe | \ icl | *[/\\]icl | icl.exe | *[/\\]icl.exe ) func_cl_wrapper "$@" # Doesn't return... ;; esac ofile= cfile= for arg do if test -n "$eat"; then eat= else case $1 in -o) # configure might choose to run compile as 'compile cc -o foo foo.c'. # So we strip '-o arg' only if arg is an object. eat=1 case $2 in *.o | *.obj) ofile=$2 ;; *) set x "$@" -o "$2" shift ;; esac ;; *.c) cfile=$1 set x "$@" "$1" shift ;; *) set x "$@" "$1" shift ;; esac fi shift done if test -z "$ofile" || test -z "$cfile"; then # If no '-o' option was seen then we might have been invoked from a # pattern rule where we don't need one. That is ok -- this is a # normal compilation that the losing compiler can handle. If no # '.c' file was seen then we are probably linking. That is also # ok. exec "$@" fi # Name of file we expect compiler to create. cofile=`echo "$cfile" | sed 's|^.*[\\/]||; s|^[a-zA-Z]:||; s/\.c$/.o/'` # Create the lock directory. # Note: use '[/\\:.-]' here to ensure that we don't use the same name # that we are using for the .o file. Also, base the name on the expected # object file name, since that is what matters with a parallel build. lockdir=`echo "$cofile" | sed -e 's|[/\\:.-]|_|g'`.d while true; do if mkdir "$lockdir" >/dev/null 2>&1; then break fi sleep 1 done # FIXME: race condition here if user kills between mkdir and trap. trap "rmdir '$lockdir'; exit 1" 1 2 15 # Run the compile. "$@" ret=$? if test -f "$cofile"; then test "$cofile" = "$ofile" || mv "$cofile" "$ofile" elif test -f "${cofile}bj"; then test "${cofile}bj" = "$ofile" || mv "${cofile}bj" "$ofile" fi rmdir "$lockdir" exit $ret # Local Variables: # mode: shell-script # sh-indentation: 2 # eval: (add-hook 'before-save-hook 'time-stamp) # time-stamp-start: "scriptversion=" # time-stamp-format: "%:y-%02m-%02d.%02H" # time-stamp-time-zone: "UTC0" # time-stamp-end: "; # UTC" # End: guile-ssh-0.18.0/build-aux/config.rpath000077500000000000000000000443041471416131000177050ustar00rootroot00000000000000#!/gnu/store/ykzwykkvr2c80rw4l1qh3mvfdkl7jibi-bash-4.3.42/bin/sh # Output a system dependent set of variables, describing how to set the # run time search path of shared libraries in an executable. # # Copyright 1996-2016 Free Software Foundation, Inc. # Taken from GNU libtool, 2001 # Originally by Gordon Matzigkeit , 1996 # # This file is free software; the Free Software Foundation gives # unlimited permission to copy and/or distribute it, with or without # modifications, as long as this notice is preserved. # # The first argument passed to this file is the canonical host specification, # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM # or # CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM # The environment variables CC, GCC, LDFLAGS, LD, with_gnu_ld # should be set by the caller. # # The set of defined variables is at the end of this script. # Known limitations: # - On IRIX 6.5 with CC="cc", the run time search patch must not be longer # than 256 bytes, otherwise the compiler driver will dump core. The only # known workaround is to choose shorter directory names for the build # directory and/or the installation directory. # All known linkers require a '.a' archive for static linking (except MSVC, # which needs '.lib'). libext=a shrext=.so host="$1" host_cpu=`echo "$host" | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'` host_vendor=`echo "$host" | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'` host_os=`echo "$host" | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'` # Code taken from libtool.m4's _LT_CC_BASENAME. for cc_temp in $CC""; do case $cc_temp in compile | *[\\/]compile | ccache | *[\\/]ccache ) ;; distcc | *[\\/]distcc | purify | *[\\/]purify ) ;; \-*) ;; *) break;; esac done cc_basename=`echo "$cc_temp" | sed -e 's%^.*/%%'` # Code taken from libtool.m4's _LT_COMPILER_PIC. wl= if test "$GCC" = yes; then wl='-Wl,' else case "$host_os" in aix*) wl='-Wl,' ;; mingw* | cygwin* | pw32* | os2* | cegcc*) ;; hpux9* | hpux10* | hpux11*) wl='-Wl,' ;; irix5* | irix6* | nonstopux*) wl='-Wl,' ;; linux* | k*bsd*-gnu | kopensolaris*-gnu) case $cc_basename in ecc*) wl='-Wl,' ;; icc* | ifort*) wl='-Wl,' ;; lf95*) wl='-Wl,' ;; nagfor*) wl='-Wl,-Wl,,' ;; pgcc* | pgf77* | pgf90* | pgf95* | pgfortran*) wl='-Wl,' ;; ccc*) wl='-Wl,' ;; xl* | bgxl* | bgf* | mpixl*) wl='-Wl,' ;; como) wl='-lopt=' ;; *) case `$CC -V 2>&1 | sed 5q` in *Sun\ F* | *Sun*Fortran*) wl= ;; *Sun\ C*) wl='-Wl,' ;; esac ;; esac ;; newsos6) ;; *nto* | *qnx*) ;; osf3* | osf4* | osf5*) wl='-Wl,' ;; rdos*) ;; solaris*) case $cc_basename in f77* | f90* | f95* | sunf77* | sunf90* | sunf95*) wl='-Qoption ld ' ;; *) wl='-Wl,' ;; esac ;; sunos4*) wl='-Qoption ld ' ;; sysv4 | sysv4.2uw2* | sysv4.3*) wl='-Wl,' ;; sysv4*MP*) ;; sysv5* | unixware* | sco3.2v5* | sco5v6* | OpenUNIX*) wl='-Wl,' ;; unicos*) wl='-Wl,' ;; uts4*) ;; esac fi # Code taken from libtool.m4's _LT_LINKER_SHLIBS. hardcode_libdir_flag_spec= hardcode_libdir_separator= hardcode_direct=no hardcode_minus_L=no case "$host_os" in cygwin* | mingw* | pw32* | cegcc*) # FIXME: the MSVC++ port hasn't been tested in a loooong time # When not using gcc, we currently assume that we are using # Microsoft Visual C++. if test "$GCC" != yes; then with_gnu_ld=no fi ;; interix*) # we just hope/assume this is gcc and not c89 (= MSVC++) with_gnu_ld=yes ;; openbsd*) with_gnu_ld=no ;; esac ld_shlibs=yes if test "$with_gnu_ld" = yes; then # Set some defaults for GNU ld with shared library support. These # are reset later if shared libraries are not supported. Putting them # here allows them to be overridden if necessary. # Unlike libtool, we use -rpath here, not --rpath, since the documented # option of GNU ld is called -rpath, not --rpath. hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir' case "$host_os" in aix[3-9]*) # On AIX/PPC, the GNU linker is very broken if test "$host_cpu" != ia64; then ld_shlibs=no fi ;; amigaos*) case "$host_cpu" in powerpc) ;; m68k) hardcode_libdir_flag_spec='-L$libdir' hardcode_minus_L=yes ;; esac ;; beos*) if $LD --help 2>&1 | grep ': supported targets:.* elf' > /dev/null; then : else ld_shlibs=no fi ;; cygwin* | mingw* | pw32* | cegcc*) # hardcode_libdir_flag_spec is actually meaningless, as there is # no search path for DLLs. hardcode_libdir_flag_spec='-L$libdir' if $LD --help 2>&1 | grep 'auto-import' > /dev/null; then : else ld_shlibs=no fi ;; haiku*) ;; interix[3-9]*) hardcode_direct=no hardcode_libdir_flag_spec='${wl}-rpath,$libdir' ;; gnu* | linux* | tpf* | k*bsd*-gnu | kopensolaris*-gnu) if $LD --help 2>&1 | grep ': supported targets:.* elf' > /dev/null; then : else ld_shlibs=no fi ;; netbsd*) ;; solaris*) if $LD -v 2>&1 | grep 'BFD 2\.8' > /dev/null; then ld_shlibs=no elif $LD --help 2>&1 | grep ': supported targets:.* elf' > /dev/null; then : else ld_shlibs=no fi ;; sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX*) case `$LD -v 2>&1` in *\ [01].* | *\ 2.[0-9].* | *\ 2.1[0-5].*) ld_shlibs=no ;; *) if $LD --help 2>&1 | grep ': supported targets:.* elf' > /dev/null; then hardcode_libdir_flag_spec='`test -z "$SCOABSPATH" && echo ${wl}-rpath,$libdir`' else ld_shlibs=no fi ;; esac ;; sunos4*) hardcode_direct=yes ;; *) if $LD --help 2>&1 | grep ': supported targets:.* elf' > /dev/null; then : else ld_shlibs=no fi ;; esac if test "$ld_shlibs" = no; then hardcode_libdir_flag_spec= fi else case "$host_os" in aix3*) # Note: this linker hardcodes the directories in LIBPATH if there # are no directories specified by -L. hardcode_minus_L=yes if test "$GCC" = yes; then # Neither direct hardcoding nor static linking is supported with a # broken collect2. hardcode_direct=unsupported fi ;; aix[4-9]*) if test "$host_cpu" = ia64; then # On IA64, the linker does run time linking by default, so we don't # have to do anything special. aix_use_runtimelinking=no else aix_use_runtimelinking=no # Test if we are trying to use run time linking or normal # AIX style linking. If -brtl is somewhere in LDFLAGS, we # need to do runtime linking. case $host_os in aix4.[23]|aix4.[23].*|aix[5-9]*) for ld_flag in $LDFLAGS; do if (test $ld_flag = "-brtl" || test $ld_flag = "-Wl,-brtl"); then aix_use_runtimelinking=yes break fi done ;; esac fi hardcode_direct=yes hardcode_libdir_separator=':' if test "$GCC" = yes; then case $host_os in aix4.[012]|aix4.[012].*) collect2name=`${CC} -print-prog-name=collect2` if test -f "$collect2name" && \ strings "$collect2name" | grep resolve_lib_name >/dev/null then # We have reworked collect2 : else # We have old collect2 hardcode_direct=unsupported hardcode_minus_L=yes hardcode_libdir_flag_spec='-L$libdir' hardcode_libdir_separator= fi ;; esac fi # Begin _LT_AC_SYS_LIBPATH_AIX. echo 'int main () { return 0; }' > conftest.c ${CC} ${LDFLAGS} conftest.c -o conftest aix_libpath=`dump -H conftest 2>/dev/null | sed -n -e '/Import File Strings/,/^$/ { /^0/ { s/^0 *\(.*\)$/\1/; p; } }'` if test -z "$aix_libpath"; then aix_libpath=`dump -HX64 conftest 2>/dev/null | sed -n -e '/Import File Strings/,/^$/ { /^0/ { s/^0 *\(.*\)$/\1/; p; } }'` fi if test -z "$aix_libpath"; then aix_libpath="/usr/lib:/lib" fi rm -f conftest.c conftest # End _LT_AC_SYS_LIBPATH_AIX. if test "$aix_use_runtimelinking" = yes; then hardcode_libdir_flag_spec='${wl}-blibpath:$libdir:'"$aix_libpath" else if test "$host_cpu" = ia64; then hardcode_libdir_flag_spec='${wl}-R $libdir:/usr/lib:/lib' else hardcode_libdir_flag_spec='${wl}-blibpath:$libdir:'"$aix_libpath" fi fi ;; amigaos*) case "$host_cpu" in powerpc) ;; m68k) hardcode_libdir_flag_spec='-L$libdir' hardcode_minus_L=yes ;; esac ;; bsdi[45]*) ;; cygwin* | mingw* | pw32* | cegcc*) # When not using gcc, we currently assume that we are using # Microsoft Visual C++. # hardcode_libdir_flag_spec is actually meaningless, as there is # no search path for DLLs. hardcode_libdir_flag_spec=' ' libext=lib ;; darwin* | rhapsody*) hardcode_direct=no if { case $cc_basename in ifort*) true;; *) test "$GCC" = yes;; esac; }; then : else ld_shlibs=no fi ;; dgux*) hardcode_libdir_flag_spec='-L$libdir' ;; freebsd2.[01]*) hardcode_direct=yes hardcode_minus_L=yes ;; freebsd* | dragonfly*) hardcode_libdir_flag_spec='-R$libdir' hardcode_direct=yes ;; hpux9*) hardcode_libdir_flag_spec='${wl}+b ${wl}$libdir' hardcode_libdir_separator=: hardcode_direct=yes # hardcode_minus_L: Not really in the search PATH, # but as the default location of the library. hardcode_minus_L=yes ;; hpux10*) if test "$with_gnu_ld" = no; then hardcode_libdir_flag_spec='${wl}+b ${wl}$libdir' hardcode_libdir_separator=: hardcode_direct=yes # hardcode_minus_L: Not really in the search PATH, # but as the default location of the library. hardcode_minus_L=yes fi ;; hpux11*) if test "$with_gnu_ld" = no; then hardcode_libdir_flag_spec='${wl}+b ${wl}$libdir' hardcode_libdir_separator=: case $host_cpu in hppa*64*|ia64*) hardcode_direct=no ;; *) hardcode_direct=yes # hardcode_minus_L: Not really in the search PATH, # but as the default location of the library. hardcode_minus_L=yes ;; esac fi ;; irix5* | irix6* | nonstopux*) hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir' hardcode_libdir_separator=: ;; netbsd*) hardcode_libdir_flag_spec='-R$libdir' hardcode_direct=yes ;; newsos6) hardcode_direct=yes hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir' hardcode_libdir_separator=: ;; *nto* | *qnx*) ;; openbsd*) if test -f /usr/libexec/ld.so; then hardcode_direct=yes if test -z "`echo __ELF__ | $CC -E - | grep __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then hardcode_libdir_flag_spec='${wl}-rpath,$libdir' else case "$host_os" in openbsd[01].* | openbsd2.[0-7] | openbsd2.[0-7].*) hardcode_libdir_flag_spec='-R$libdir' ;; *) hardcode_libdir_flag_spec='${wl}-rpath,$libdir' ;; esac fi else ld_shlibs=no fi ;; os2*) hardcode_libdir_flag_spec='-L$libdir' hardcode_minus_L=yes ;; osf3*) hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir' hardcode_libdir_separator=: ;; osf4* | osf5*) if test "$GCC" = yes; then hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir' else # Both cc and cxx compiler support -rpath directly hardcode_libdir_flag_spec='-rpath $libdir' fi hardcode_libdir_separator=: ;; solaris*) hardcode_libdir_flag_spec='-R$libdir' ;; sunos4*) hardcode_libdir_flag_spec='-L$libdir' hardcode_direct=yes hardcode_minus_L=yes ;; sysv4) case $host_vendor in sni) hardcode_direct=yes # is this really true??? ;; siemens) hardcode_direct=no ;; motorola) hardcode_direct=no #Motorola manual says yes, but my tests say they lie ;; esac ;; sysv4.3*) ;; sysv4*MP*) if test -d /usr/nec; then ld_shlibs=yes fi ;; sysv4*uw2* | sysv5OpenUNIX* | sysv5UnixWare7.[01].[10]* | unixware7* | sco3.2v5.0.[024]*) ;; sysv5* | sco3.2v5* | sco5v6*) hardcode_libdir_flag_spec='`test -z "$SCOABSPATH" && echo ${wl}-R,$libdir`' hardcode_libdir_separator=':' ;; uts4*) hardcode_libdir_flag_spec='-L$libdir' ;; *) ld_shlibs=no ;; esac fi # Check dynamic linker characteristics # Code taken from libtool.m4's _LT_SYS_DYNAMIC_LINKER. # Unlike libtool.m4, here we don't care about _all_ names of the library, but # only about the one the linker finds when passed -lNAME. This is the last # element of library_names_spec in libtool.m4, or possibly two of them if the # linker has special search rules. library_names_spec= # the last element of library_names_spec in libtool.m4 libname_spec='lib$name' case "$host_os" in aix3*) library_names_spec='$libname.a' ;; aix[4-9]*) library_names_spec='$libname$shrext' ;; amigaos*) case "$host_cpu" in powerpc*) library_names_spec='$libname$shrext' ;; m68k) library_names_spec='$libname.a' ;; esac ;; beos*) library_names_spec='$libname$shrext' ;; bsdi[45]*) library_names_spec='$libname$shrext' ;; cygwin* | mingw* | pw32* | cegcc*) shrext=.dll library_names_spec='$libname.dll.a $libname.lib' ;; darwin* | rhapsody*) shrext=.dylib library_names_spec='$libname$shrext' ;; dgux*) library_names_spec='$libname$shrext' ;; freebsd[23].*) library_names_spec='$libname$shrext$versuffix' ;; freebsd* | dragonfly*) library_names_spec='$libname$shrext' ;; gnu*) library_names_spec='$libname$shrext' ;; haiku*) library_names_spec='$libname$shrext' ;; hpux9* | hpux10* | hpux11*) case $host_cpu in ia64*) shrext=.so ;; hppa*64*) shrext=.sl ;; *) shrext=.sl ;; esac library_names_spec='$libname$shrext' ;; interix[3-9]*) library_names_spec='$libname$shrext' ;; irix5* | irix6* | nonstopux*) library_names_spec='$libname$shrext' case "$host_os" in irix5* | nonstopux*) libsuff= shlibsuff= ;; *) case $LD in *-32|*"-32 "|*-melf32bsmip|*"-melf32bsmip ") libsuff= shlibsuff= ;; *-n32|*"-n32 "|*-melf32bmipn32|*"-melf32bmipn32 ") libsuff=32 shlibsuff=N32 ;; *-64|*"-64 "|*-melf64bmip|*"-melf64bmip ") libsuff=64 shlibsuff=64 ;; *) libsuff= shlibsuff= ;; esac ;; esac ;; linux*oldld* | linux*aout* | linux*coff*) ;; linux* | k*bsd*-gnu | kopensolaris*-gnu) library_names_spec='$libname$shrext' ;; knetbsd*-gnu) library_names_spec='$libname$shrext' ;; netbsd*) library_names_spec='$libname$shrext' ;; newsos6) library_names_spec='$libname$shrext' ;; *nto* | *qnx*) library_names_spec='$libname$shrext' ;; openbsd*) library_names_spec='$libname$shrext$versuffix' ;; os2*) libname_spec='$name' shrext=.dll library_names_spec='$libname.a' ;; osf3* | osf4* | osf5*) library_names_spec='$libname$shrext' ;; rdos*) ;; solaris*) library_names_spec='$libname$shrext' ;; sunos4*) library_names_spec='$libname$shrext$versuffix' ;; sysv4 | sysv4.3*) library_names_spec='$libname$shrext' ;; sysv4*MP*) library_names_spec='$libname$shrext' ;; sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*) library_names_spec='$libname$shrext' ;; tpf*) library_names_spec='$libname$shrext' ;; uts4*) library_names_spec='$libname$shrext' ;; esac sed_quote_subst='s/\(["`$\\]\)/\\\1/g' escaped_wl=`echo "X$wl" | sed -e 's/^X//' -e "$sed_quote_subst"` shlibext=`echo "$shrext" | sed -e 's,^\.,,'` escaped_libname_spec=`echo "X$libname_spec" | sed -e 's/^X//' -e "$sed_quote_subst"` escaped_library_names_spec=`echo "X$library_names_spec" | sed -e 's/^X//' -e "$sed_quote_subst"` escaped_hardcode_libdir_flag_spec=`echo "X$hardcode_libdir_flag_spec" | sed -e 's/^X//' -e "$sed_quote_subst"` LC_ALL=C sed -e 's/^\([a-zA-Z0-9_]*\)=/acl_cv_\1=/' <. # Written by Jim Meyering use strict; use warnings; use Getopt::Long; use POSIX qw(strftime); (my $ME = $0) =~ s|.*/||; # use File::Coda; # http://meyering.net/code/Coda/ END { defined fileno STDOUT or return; close STDOUT and return; warn "$ME: failed to close standard output: $!\n"; $? ||= 1; } sub usage ($) { my ($exit_code) = @_; my $STREAM = ($exit_code == 0 ? *STDOUT : *STDERR); if ($exit_code != 0) { print $STREAM "Try '$ME --help' for more information.\n"; } else { print $STREAM < ChangeLog $ME -- -n 5 foo > last-5-commits-to-branch-foo SPECIAL SYNTAX: The following types of strings are interpreted specially when they appear at the beginning of a log message line. They are not copied to the output. Copyright-paperwork-exempt: Yes Append the "(tiny change)" notation to the usual "date name email" ChangeLog header to mark a change that does not require a copyright assignment. Co-authored-by: Joe User List the specified name and email address on a second ChangeLog header, denoting a co-author. Signed-off-by: Joe User These lines are simply elided. In a FILE specified via --amend, comment lines (starting with "#") are ignored. FILE must consist of pairs where SHA is a 40-byte SHA1 (alone on a line) referring to a commit in the current project, and CODE refers to one or more consecutive lines of Perl code. Pairs must be separated by one or more blank line. Here is sample input for use with --amend=FILE, from coreutils: 3a169f4c5d9159283548178668d2fae6fced3030 # fix typo in title: s/all tile types/all file types/ 1379ed974f1fa39b12e2ffab18b3f7a607082202 # Due to a bug in vc-dwim, I mis-attributed a patch by Paul to myself. # Change the author to be Paul. Note the escaped "@": s,Jim .*>,Paul Eggert , EOF } exit $exit_code; } # If the string $S is a well-behaved file name, simply return it. # If it contains white space, quotes, etc., quote it, and return the new string. sub shell_quote($) { my ($s) = @_; if ($s =~ m![^\w+/.,-]!) { # Convert each single quote to '\'' $s =~ s/\'/\'\\\'\'/g; # Then single quote the string. $s = "'$s'"; } return $s; } sub quoted_cmd(@) { return join (' ', map {shell_quote $_} @_); } # Parse file F. # Comment lines (starting with "#") are ignored. # F must consist of pairs where SHA is a 40-byte SHA1 # (alone on a line) referring to a commit in the current project, and # CODE refers to one or more consecutive lines of Perl code. # Pairs must be separated by one or more blank line. sub parse_amend_file($) { my ($f) = @_; open F, '<', $f or die "$ME: $f: failed to open for reading: $!\n"; my $fail; my $h = {}; my $in_code = 0; my $sha; while (defined (my $line = )) { $line =~ /^\#/ and next; chomp $line; $line eq '' and $in_code = 0, next; if (!$in_code) { $line =~ /^([0-9a-fA-F]{40})$/ or (warn "$ME: $f:$.: invalid line; expected an SHA1\n"), $fail = 1, next; $sha = lc $1; $in_code = 1; exists $h->{$sha} and (warn "$ME: $f:$.: duplicate SHA1\n"), $fail = 1, next; } else { $h->{$sha} ||= ''; $h->{$sha} .= "$line\n"; } } close F; $fail and exit 1; return $h; } # git_dir_option $SRCDIR # # From $SRCDIR, the --git-dir option to pass to git (none if $SRCDIR # is undef). Return as a list (0 or 1 element). sub git_dir_option($) { my ($srcdir) = @_; my @res = (); if (defined $srcdir) { my $qdir = shell_quote $srcdir; my $cmd = "cd $qdir && git rev-parse --show-toplevel"; my $qcmd = shell_quote $cmd; my $git_dir = qx($cmd); defined $git_dir or die "$ME: cannot run $qcmd: $!\n"; $? == 0 or die "$ME: $qcmd had unexpected exit code or signal ($?)\n"; chomp $git_dir; push @res, "--git-dir=$git_dir/.git"; } @res; } { my $since_date; my $format_string = '%s%n%b%n'; my $amend_file; my $append_dot = 0; my $cluster = 1; my $strip_tab = 0; my $strip_cherry_pick = 0; my $srcdir; GetOptions ( help => sub { usage 0 }, version => sub { print "$ME version $VERSION\n"; exit }, 'since=s' => \$since_date, 'format=s' => \$format_string, 'amend=s' => \$amend_file, 'append-dot' => \$append_dot, 'cluster!' => \$cluster, 'strip-tab' => \$strip_tab, 'strip-cherry-pick' => \$strip_cherry_pick, 'srcdir=s' => \$srcdir, ) or usage 1; defined $since_date and unshift @ARGV, "--since=$since_date"; # This is a hash that maps an SHA1 to perl code (i.e., s/old/new/) # that makes a correction in the log or attribution of that commit. my $amend_code = defined $amend_file ? parse_amend_file $amend_file : {}; my @cmd = ('git', git_dir_option $srcdir, qw(log --log-size), '--pretty=format:%H:%ct %an <%ae>%n%n'.$format_string, @ARGV); open PIPE, '-|', @cmd or die ("$ME: failed to run '". quoted_cmd (@cmd) ."': $!\n" . "(Is your Git too old? Version 1.5.1 or later is required.)\n"); my $prev_multi_paragraph; my $prev_date_line = ''; my @prev_coauthors = (); while (1) { defined (my $in = ) or last; $in =~ /^log size (\d+)$/ or die "$ME:$.: Invalid line (expected log size):\n$in"; my $log_nbytes = $1; my $log; my $n_read = read PIPE, $log, $log_nbytes; $n_read == $log_nbytes or die "$ME:$.: unexpected EOF\n"; # Extract leading hash. my ($sha, $rest) = split ':', $log, 2; defined $sha or die "$ME:$.: malformed log entry\n"; $sha =~ /^[0-9a-fA-F]{40}$/ or die "$ME:$.: invalid SHA1: $sha\n"; # If this commit's log requires any transformation, do it now. my $code = $amend_code->{$sha}; if (defined $code) { eval 'use Safe'; my $s = new Safe; # Put the unpreprocessed entry into "$_". $_ = $rest; # Let $code operate on it, safely. my $r = $s->reval("$code") or die "$ME:$.:$sha: failed to eval \"$code\":\n$@\n"; # Note that we've used this entry. delete $amend_code->{$sha}; # Update $rest upon success. $rest = $_; } # Remove lines inserted by "git cherry-pick". if ($strip_cherry_pick) { $rest =~ s/^\s*Conflicts:\n.*//sm; $rest =~ s/^\s*\(cherry picked from commit [\da-f]+\)\n//m; } my @line = split "\n", $rest; my $author_line = shift @line; defined $author_line or die "$ME:$.: unexpected EOF\n"; $author_line =~ /^(\d+) (.*>)$/ or die "$ME:$.: Invalid line " . "(expected date/author/email):\n$author_line\n"; # Format 'Copyright-paperwork-exempt: Yes' as a standard ChangeLog # `(tiny change)' annotation. my $tiny = (grep (/^Copyright-paperwork-exempt:\s+[Yy]es$/, @line) ? ' (tiny change)' : ''); my $date_line = sprintf "%s %s$tiny\n", strftime ("%F", localtime ($1)), $2; my @coauthors = grep /^Co-authored-by:.*$/, @line; # Omit meta-data lines we've already interpreted. @line = grep !/^(?:Signed-off-by:[ ].*>$ |Co-authored-by:[ ] |Copyright-paperwork-exempt:[ ] )/x, @line; # Remove leading and trailing blank lines. if (@line) { while ($line[0] =~ /^\s*$/) { shift @line; } while ($line[$#line] =~ /^\s*$/) { pop @line; } } # Record whether there are two or more paragraphs. my $multi_paragraph = grep /^\s*$/, @line; # Format 'Co-authored-by: A U Thor ' lines in # standard multi-author ChangeLog format. for (@coauthors) { s/^Co-authored-by:\s*/\t /; s/\s*/ or warn "$ME: warning: missing email address for " . substr ($_, 5) . "\n"; } # If clustering of commit messages has been disabled, if this header # would be different from the previous date/name/email/coauthors header, # or if this or the previous entry consists of two or more paragraphs, # then print the header. if ( ! $cluster || $date_line ne $prev_date_line || "@coauthors" ne "@prev_coauthors" || $multi_paragraph || $prev_multi_paragraph) { $prev_date_line eq '' or print "\n"; print $date_line; @coauthors and print join ("\n", @coauthors), "\n"; } $prev_date_line = $date_line; @prev_coauthors = @coauthors; $prev_multi_paragraph = $multi_paragraph; # If there were any lines if (@line == 0) { warn "$ME: warning: empty commit message:\n $date_line\n"; } else { if ($append_dot) { # If the first line of the message has enough room, then if (length $line[0] < 72) { # append a dot if there is no other punctuation or blank # at the end. $line[0] =~ /[[:punct:]\s]$/ or $line[0] .= '.'; } } # Remove one additional leading TAB from each line. $strip_tab and map { s/^\t// } @line; # Prefix each non-empty line with a TAB. @line = map { length $_ ? "\t$_" : '' } @line; print "\n", join ("\n", @line), "\n"; } defined ($in = ) or last; $in ne "\n" and die "$ME:$.: unexpected line:\n$in"; } close PIPE or die "$ME: error closing pipe from " . quoted_cmd (@cmd) . "\n"; # FIXME-someday: include $PROCESS_STATUS in the diagnostic # Complain about any unused entry in the --amend=F specified file. my $fail = 0; foreach my $sha (keys %$amend_code) { warn "$ME:$amend_file: unused entry: $sha\n"; $fail = 1; } exit $fail; } # Local Variables: # mode: perl # indent-tabs-mode: nil # eval: (add-hook 'write-file-hooks 'time-stamp) # time-stamp-start: "my $VERSION = '" # time-stamp-format: "%:y-%02m-%02d %02H:%02M" # time-stamp-time-zone: "UTC" # time-stamp-end: "'; # UTC" # End: guile-ssh-0.18.0/build-aux/m4/000077500000000000000000000000001471416131000157105ustar00rootroot00000000000000guile-ssh-0.18.0/build-aux/m4/.gitignore000066400000000000000000000001361471416131000177000ustar00rootroot00000000000000# -*- shell-script -*- libtool.m4 ltoptions.m4 ltsugar.m4 ltversion.m4 lt~obsolete.m4 pkg.m4 guile-ssh-0.18.0/build-aux/m4/Makefile.am000066400000000000000000000000471471416131000177450ustar00rootroot00000000000000EXTRA_DIST = \ guile.m4 \ lib-link.m4guile-ssh-0.18.0/build-aux/m4/guile.m4000066400000000000000000000365561471416131000172760ustar00rootroot00000000000000## Autoconf macros for working with Guile. ## ## Copyright (C) 1998,2001, 2006, 2010, 2012, 2013, 2014, 2020 Free Software Foundation, Inc. ## ## This library is free software; you can redistribute it and/or ## modify it under the terms of the GNU Lesser General Public License ## as published by the Free Software Foundation; either version 3 of ## the License, or (at your option) any later version. ## ## This library 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 ## Lesser General Public License for more details. ## ## You should have received a copy of the GNU Lesser General Public ## License along with this library; if not, write to the Free Software ## Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA ## 02110-1301 USA # serial 11 ## Index ## ----- ## ## GUILE_PKG -- find Guile development files ## GUILE_PROGS -- set paths to Guile interpreter, config and tool programs ## GUILE_FLAGS -- set flags for compiling and linking with Guile ## GUILE_SITE_DIR -- find path to Guile "site" directories ## GUILE_CHECK -- evaluate Guile Scheme code and capture the return value ## GUILE_MODULE_CHECK -- check feature of a Guile Scheme module ## GUILE_MODULE_AVAILABLE -- check availability of a Guile Scheme module ## GUILE_MODULE_REQUIRED -- fail if a Guile Scheme module is unavailable ## GUILE_MODULE_EXPORTS -- check if a module exports a variable ## GUILE_MODULE_REQUIRED_EXPORT -- fail if a module doesn't export a variable ## Code ## ---- ## NOTE: Comments preceding an AC_DEFUN (starting from "Usage:") are massaged ## into doc/ref/autoconf-macros.texi (see Makefile.am in that directory). # GUILE_PKG -- find Guile development files # # Usage: GUILE_PKG([VERSIONS]) # # This macro runs the @code{pkg-config} tool to find development files # for an available version of Guile. # # By default, this macro will search for the latest stable version of # Guile (e.g. 3.0), falling back to the previous stable version # (e.g. 2.2) if it is available. If no guile-@var{VERSION}.pc file is # found, an error is signalled. The found version is stored in # @var{GUILE_EFFECTIVE_VERSION}. # # If @code{GUILE_PROGS} was already invoked, this macro ensures that the # development files have the same effective version as the Guile # program. # # @var{GUILE_EFFECTIVE_VERSION} is marked for substitution, as by # @code{AC_SUBST}. # AC_DEFUN([GUILE_PKG], [AC_REQUIRE([PKG_PROG_PKG_CONFIG]) if test "x$PKG_CONFIG" = x; then AC_MSG_ERROR([pkg-config is missing, please install it]) fi _guile_versions_to_search="m4_default([$1], [3.0 2.2 2.0])" if test -n "$GUILE_EFFECTIVE_VERSION"; then _guile_tmp="" for v in $_guile_versions_to_search; do if test "$v" = "$GUILE_EFFECTIVE_VERSION"; then _guile_tmp=$v fi done if test -z "$_guile_tmp"; then AC_MSG_FAILURE([searching for guile development files for versions $_guile_versions_to_search, but previously found $GUILE version $GUILE_EFFECTIVE_VERSION]) fi _guile_versions_to_search=$GUILE_EFFECTIVE_VERSION fi GUILE_EFFECTIVE_VERSION="" _guile_errors="" for v in $_guile_versions_to_search; do if test -z "$GUILE_EFFECTIVE_VERSION"; then AC_MSG_NOTICE([checking for guile $v]) PKG_CHECK_EXISTS([guile-$v], [GUILE_EFFECTIVE_VERSION=$v], []) fi done if test -z "$GUILE_EFFECTIVE_VERSION"; then AC_MSG_ERROR([ No Guile development packages were found. Please verify that you have Guile installed. If you installed Guile from a binary distribution, please verify that you have also installed the development packages. If you installed it yourself, you might need to adjust your PKG_CONFIG_PATH; see the pkg-config man page for more. ]) fi AC_MSG_NOTICE([found guile $GUILE_EFFECTIVE_VERSION]) AC_SUBST([GUILE_EFFECTIVE_VERSION]) ]) # GUILE_FLAGS -- set flags for compiling and linking with Guile # # Usage: GUILE_FLAGS # # This macro runs the @code{pkg-config} tool to find out how to compile # and link programs against Guile. It sets four variables: # @var{GUILE_CFLAGS}, @var{GUILE_LDFLAGS}, @var{GUILE_LIBS}, and # @var{GUILE_LTLIBS}. # # @var{GUILE_CFLAGS}: flags to pass to a C or C++ compiler to build code that # uses Guile header files. This is almost always just one or more @code{-I} # flags. # # @var{GUILE_LDFLAGS}: flags to pass to the compiler to link a program # against Guile. This includes @code{-lguile-@var{VERSION}} for the # Guile library itself, and may also include one or more @code{-L} flag # to tell the compiler where to find the libraries. But it does not # include flags that influence the program's runtime search path for # libraries, and will therefore lead to a program that fails to start, # unless all necessary libraries are installed in a standard location # such as @file{/usr/lib}. # # @var{GUILE_LIBS} and @var{GUILE_LTLIBS}: flags to pass to the compiler or to # libtool, respectively, to link a program against Guile. It includes flags # that augment the program's runtime search path for libraries, so that shared # libraries will be found at the location where they were during linking, even # in non-standard locations. @var{GUILE_LIBS} is to be used when linking the # program directly with the compiler, whereas @var{GUILE_LTLIBS} is to be used # when linking the program is done through libtool. # # The variables are marked for substitution, as by @code{AC_SUBST}. # AC_DEFUN([GUILE_FLAGS], [AC_REQUIRE([GUILE_PKG]) PKG_CHECK_MODULES(GUILE, [guile-$GUILE_EFFECTIVE_VERSION]) dnl GUILE_CFLAGS and GUILE_LIBS are already defined and AC_SUBST'd by dnl PKG_CHECK_MODULES. But GUILE_LIBS to pkg-config is GUILE_LDFLAGS dnl to us. GUILE_LDFLAGS=$GUILE_LIBS dnl Determine the platform dependent parameters needed to use rpath. dnl AC_LIB_LINKFLAGS_FROM_LIBS is defined in gnulib/m4/lib-link.m4 and needs dnl the file gnulib/build-aux/config.rpath. AC_LIB_LINKFLAGS_FROM_LIBS([GUILE_LIBS], [$GUILE_LDFLAGS], []) GUILE_LIBS="$GUILE_LDFLAGS $GUILE_LIBS" AC_LIB_LINKFLAGS_FROM_LIBS([GUILE_LTLIBS], [$GUILE_LDFLAGS], [yes]) GUILE_LTLIBS="$GUILE_LDFLAGS $GUILE_LTLIBS" AC_SUBST([GUILE_EFFECTIVE_VERSION]) AC_SUBST([GUILE_CFLAGS]) AC_SUBST([GUILE_LDFLAGS]) AC_SUBST([GUILE_LIBS]) AC_SUBST([GUILE_LTLIBS]) ]) # GUILE_SITE_DIR -- find path to Guile site directories # # Usage: GUILE_SITE_DIR # # This looks for Guile's "site" directories. The variable @var{GUILE_SITE} will # be set to Guile's "site" directory for Scheme source files (usually something # like PREFIX/share/guile/site). @var{GUILE_SITE_CCACHE} will be set to the # directory for compiled Scheme files also known as @code{.go} files # (usually something like # PREFIX/lib/guile/@var{GUILE_EFFECTIVE_VERSION}/site-ccache). # @var{GUILE_EXTENSION} will be set to the directory for compiled C extensions # (usually something like # PREFIX/lib/guile/@var{GUILE_EFFECTIVE_VERSION}/extensions). The latter two # are set to blank if the particular version of Guile does not support # them. Note that this macro will run the macros @code{GUILE_PKG} and # @code{GUILE_PROGS} if they have not already been run. # # The variables are marked for substitution, as by @code{AC_SUBST}. # AC_DEFUN([GUILE_SITE_DIR], [AC_REQUIRE([GUILE_PKG]) AC_REQUIRE([GUILE_PROGS]) AC_MSG_CHECKING(for Guile site directory) GUILE_SITE=`$PKG_CONFIG --print-errors --variable=sitedir guile-$GUILE_EFFECTIVE_VERSION` AC_MSG_RESULT($GUILE_SITE) if test "$GUILE_SITE" = ""; then AC_MSG_FAILURE(sitedir not found) fi AC_SUBST(GUILE_SITE) AC_MSG_CHECKING([for Guile site-ccache directory using pkgconfig]) GUILE_SITE_CCACHE=`$PKG_CONFIG --variable=siteccachedir guile-$GUILE_EFFECTIVE_VERSION` if test "$GUILE_SITE_CCACHE" = ""; then AC_MSG_RESULT(no) AC_MSG_CHECKING([for Guile site-ccache directory using interpreter]) GUILE_SITE_CCACHE=`$GUILE -c "(display (if (defined? '%site-ccache-dir) (%site-ccache-dir) \"\"))"` if test $? != "0" -o "$GUILE_SITE_CCACHE" = ""; then AC_MSG_RESULT(no) GUILE_SITE_CCACHE="" AC_MSG_WARN([siteccachedir not found]) fi fi AC_MSG_RESULT($GUILE_SITE_CCACHE) AC_SUBST([GUILE_SITE_CCACHE]) AC_MSG_CHECKING(for Guile extensions directory) GUILE_EXTENSION=`$PKG_CONFIG --print-errors --variable=extensiondir guile-$GUILE_EFFECTIVE_VERSION` AC_MSG_RESULT($GUILE_EXTENSION) if test "$GUILE_EXTENSION" = ""; then GUILE_EXTENSION="" AC_MSG_WARN(extensiondir not found) fi AC_SUBST(GUILE_EXTENSION) ]) # GUILE_PROGS -- set paths to Guile interpreter, config and tool programs # # Usage: GUILE_PROGS([VERSION]) # # This macro looks for programs @code{guile} and @code{guild}, setting # variables @var{GUILE} and @var{GUILD} to their paths, respectively. # The macro will attempt to find @code{guile} with the suffix of # @code{-X.Y}, followed by looking for it with the suffix @code{X.Y}, and # then fall back to looking for @code{guile} with no suffix. If # @code{guile} is still not found, signal an error. The suffix, if any, # that was required to find @code{guile} will be used for @code{guild} # as well. # # By default, this macro will search for the latest stable version of # Guile (e.g. 3.0). x.y or x.y.z versions can be specified. If an older # version is found, the macro will signal an error. # # The effective version of the found @code{guile} is set to # @var{GUILE_EFFECTIVE_VERSION}. This macro ensures that the effective # version is compatible with the result of a previous invocation of # @code{GUILE_FLAGS}, if any. # # As a legacy interface, it also looks for @code{guile-config} and # @code{guile-tools}, setting @var{GUILE_CONFIG} and @var{GUILE_TOOLS}. # # The variables are marked for substitution, as by @code{AC_SUBST}. # AC_DEFUN([GUILE_PROGS], [_guile_required_version="m4_default([$1], [$GUILE_EFFECTIVE_VERSION])" if test -z "$_guile_required_version"; then _guile_required_version=3.0 fi _guile_candidates=guile _tmp= for v in `echo "$_guile_required_version" | tr . ' '`; do if test -n "$_tmp"; then _tmp=$_tmp.; fi _tmp=$_tmp$v _guile_candidates="guile-$_tmp guile$_tmp $_guile_candidates" done AC_PATH_PROGS(GUILE,[$_guile_candidates]) if test -z "$GUILE"; then AC_MSG_ERROR([guile required but not found]) fi _guile_suffix=`echo "$GUILE" | sed -e 's,^.*/guile\(.*\)$,\1,'` _guile_effective_version=`$GUILE -c "(display (effective-version))"` if test -z "$GUILE_EFFECTIVE_VERSION"; then GUILE_EFFECTIVE_VERSION=$_guile_effective_version elif test "$GUILE_EFFECTIVE_VERSION" != "$_guile_effective_version"; then AC_MSG_ERROR([found development files for Guile $GUILE_EFFECTIVE_VERSION, but $GUILE has effective version $_guile_effective_version]) fi _guile_major_version=`$GUILE -c "(display (major-version))"` _guile_minor_version=`$GUILE -c "(display (minor-version))"` _guile_micro_version=`$GUILE -c "(display (micro-version))"` _guile_prog_version="$_guile_major_version.$_guile_minor_version.$_guile_micro_version" AC_MSG_CHECKING([for Guile version >= $_guile_required_version]) _major_version=`echo $_guile_required_version | cut -d . -f 1` _minor_version=`echo $_guile_required_version | cut -d . -f 2` _micro_version=`echo $_guile_required_version | cut -d . -f 3` if test "$_guile_major_version" -gt "$_major_version"; then true elif test "$_guile_major_version" -eq "$_major_version"; then if test "$_guile_minor_version" -gt "$_minor_version"; then true elif test "$_guile_minor_version" -eq "$_minor_version"; then if test -n "$_micro_version"; then if test "$_guile_micro_version" -lt "$_micro_version"; then AC_MSG_ERROR([Guile $_guile_required_version required, but $_guile_prog_version found]) fi fi elif test "$GUILE_EFFECTIVE_VERSION" = "$_major_version.$_minor_version" -a -z "$_micro_version"; then # Allow prereleases that have the right effective version. true else as_fn_error $? "Guile $_guile_required_version required, but $_guile_prog_version found" "$LINENO" 5 fi elif test "$GUILE_EFFECTIVE_VERSION" = "$_major_version.$_minor_version" -a -z "$_micro_version"; then # Allow prereleases that have the right effective version. true else AC_MSG_ERROR([Guile $_guile_required_version required, but $_guile_prog_version found]) fi AC_MSG_RESULT([$_guile_prog_version]) AC_PATH_PROG(GUILD,[guild$_guile_suffix]) AC_SUBST(GUILD) AC_PATH_PROG(GUILE_CONFIG,[guile-config$_guile_suffix]) AC_SUBST(GUILE_CONFIG) if test -n "$GUILD"; then GUILE_TOOLS=$GUILD else AC_PATH_PROG(GUILE_TOOLS,[guile-tools$_guile_suffix]) fi AC_SUBST(GUILE_TOOLS) ]) # GUILE_CHECK -- evaluate Guile Scheme code and capture the return value # # Usage: GUILE_CHECK_RETVAL(var,check) # # @var{var} is a shell variable name to be set to the return value. # @var{check} is a Guile Scheme expression, evaluated with "$GUILE -c", and # returning either 0 or non-#f to indicate the check passed. # Non-0 number or #f indicates failure. # Avoid using the character "#" since that confuses autoconf. # AC_DEFUN([GUILE_CHECK], [AC_REQUIRE([GUILE_PROGS]) $GUILE -c "$2" > /dev/null 2>&1 $1=$? ]) # GUILE_MODULE_CHECK -- check feature of a Guile Scheme module # # Usage: GUILE_MODULE_CHECK(var,module,featuretest,description) # # @var{var} is a shell variable name to be set to "yes" or "no". # @var{module} is a list of symbols, like: (ice-9 common-list). # @var{featuretest} is an expression acceptable to GUILE_CHECK, q.v. # @var{description} is a present-tense verb phrase (passed to AC_MSG_CHECKING). # AC_DEFUN([GUILE_MODULE_CHECK], [AC_MSG_CHECKING([if $2 $4]) GUILE_CHECK($1,(use-modules $2) (exit ((lambda () $3)))) if test "$$1" = "0" ; then $1=yes ; else $1=no ; fi AC_MSG_RESULT($$1) ]) # GUILE_MODULE_AVAILABLE -- check availability of a Guile Scheme module # # Usage: GUILE_MODULE_AVAILABLE(var,module) # # @var{var} is a shell variable name to be set to "yes" or "no". # @var{module} is a list of symbols, like: (ice-9 common-list). # AC_DEFUN([GUILE_MODULE_AVAILABLE], [GUILE_MODULE_CHECK($1,$2,0,is available) ]) # GUILE_MODULE_REQUIRED -- fail if a Guile Scheme module is unavailable # # Usage: GUILE_MODULE_REQUIRED(symlist) # # @var{symlist} is a list of symbols, WITHOUT surrounding parens, # like: ice-9 common-list. # AC_DEFUN([GUILE_MODULE_REQUIRED], [GUILE_MODULE_AVAILABLE(ac_guile_module_required, ($1)) if test "$ac_guile_module_required" = "no" ; then AC_MSG_ERROR([required guile module not found: ($1)]) fi ]) # GUILE_MODULE_EXPORTS -- check if a module exports a variable # # Usage: GUILE_MODULE_EXPORTS(var,module,modvar) # # @var{var} is a shell variable to be set to "yes" or "no". # @var{module} is a list of symbols, like: (ice-9 common-list). # @var{modvar} is the Guile Scheme variable to check. # AC_DEFUN([GUILE_MODULE_EXPORTS], [GUILE_MODULE_CHECK($1,$2,$3,exports `$3') ]) # GUILE_MODULE_REQUIRED_EXPORT -- fail if a module doesn't export a variable # # Usage: GUILE_MODULE_REQUIRED_EXPORT(module,modvar) # # @var{module} is a list of symbols, like: (ice-9 common-list). # @var{modvar} is the Guile Scheme variable to check. # AC_DEFUN([GUILE_MODULE_REQUIRED_EXPORT], [GUILE_MODULE_EXPORTS(guile_module_required_export,$1,$2) if test "$guile_module_required_export" = "no" ; then AC_MSG_ERROR([module $1 does not export $2; required]) fi ]) ## guile.m4 ends here guile-ssh-0.18.0/build-aux/m4/lib-ld.m4000066400000000000000000000071431471416131000173220ustar00rootroot00000000000000# lib-ld.m4 serial 6 dnl Copyright (C) 1996-2003, 2009-2016 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. dnl Subroutines of libtool.m4, dnl with replacements s/_*LT_PATH/AC_LIB_PROG/ and s/lt_/acl_/ to avoid dnl collision with libtool.m4. dnl From libtool-2.4. Sets the variable with_gnu_ld to yes or no. AC_DEFUN([AC_LIB_PROG_LD_GNU], [AC_CACHE_CHECK([if the linker ($LD) is GNU ld], [acl_cv_prog_gnu_ld], [# I'd rather use --version here, but apparently some GNU lds only accept -v. case `$LD -v 2>&1 /dev/null 2>&1 \ && { (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 \ || PATH_SEPARATOR=';' } fi ac_prog=ld if test "$GCC" = yes; then # Check if gcc -print-prog-name=ld gives a path. AC_MSG_CHECKING([for ld used by $CC]) case $host in *-*-mingw*) # gcc leaves a trailing carriage return which upsets mingw ac_prog=`($CC -print-prog-name=ld) 2>&5 | tr -d '\015'` ;; *) ac_prog=`($CC -print-prog-name=ld) 2>&5` ;; esac case $ac_prog in # Accept absolute paths. [[\\/]]* | ?:[[\\/]]*) re_direlt='/[[^/]][[^/]]*/\.\./' # Canonicalize the pathname of ld ac_prog=`echo "$ac_prog"| sed 's%\\\\%/%g'` while echo "$ac_prog" | grep "$re_direlt" > /dev/null 2>&1; do ac_prog=`echo $ac_prog| sed "s%$re_direlt%/%"` done test -z "$LD" && LD="$ac_prog" ;; "") # If it fails, then pretend we aren't using GCC. ac_prog=ld ;; *) # If it is relative, then search for the first ld in PATH. with_gnu_ld=unknown ;; esac elif test "$with_gnu_ld" = yes; then AC_MSG_CHECKING([for GNU ld]) else AC_MSG_CHECKING([for non-GNU ld]) fi AC_CACHE_VAL([acl_cv_path_LD], [if test -z "$LD"; then acl_save_ifs="$IFS"; IFS=$PATH_SEPARATOR for ac_dir in $PATH; do IFS="$acl_save_ifs" test -z "$ac_dir" && ac_dir=. if test -f "$ac_dir/$ac_prog" || test -f "$ac_dir/$ac_prog$ac_exeext"; then acl_cv_path_LD="$ac_dir/$ac_prog" # Check to see if the program is GNU ld. I'd rather use --version, # but apparently some variants of GNU ld only accept -v. # Break only if it was the GNU/non-GNU ld that we prefer. case `"$acl_cv_path_LD" -v 2>&1 = 1.10 to complain if config.rpath is missing. m4_ifdef([AC_REQUIRE_AUX_FILE], [AC_REQUIRE_AUX_FILE([config.rpath])]) AC_REQUIRE([AC_PROG_CC]) dnl we use $CC, $GCC, $LDFLAGS AC_REQUIRE([AC_LIB_PROG_LD]) dnl we use $LD, $with_gnu_ld AC_REQUIRE([AC_CANONICAL_HOST]) dnl we use $host AC_REQUIRE([AC_CONFIG_AUX_DIR_DEFAULT]) dnl we use $ac_aux_dir AC_CACHE_CHECK([for shared library run path origin], [acl_cv_rpath], [ CC="$CC" GCC="$GCC" LDFLAGS="$LDFLAGS" LD="$LD" with_gnu_ld="$with_gnu_ld" \ ${CONFIG_SHELL-/bin/sh} "$ac_aux_dir/config.rpath" "$host" > conftest.sh . ./conftest.sh rm -f ./conftest.sh acl_cv_rpath=done ]) wl="$acl_cv_wl" acl_libext="$acl_cv_libext" acl_shlibext="$acl_cv_shlibext" acl_libname_spec="$acl_cv_libname_spec" acl_library_names_spec="$acl_cv_library_names_spec" acl_hardcode_libdir_flag_spec="$acl_cv_hardcode_libdir_flag_spec" acl_hardcode_libdir_separator="$acl_cv_hardcode_libdir_separator" acl_hardcode_direct="$acl_cv_hardcode_direct" acl_hardcode_minus_L="$acl_cv_hardcode_minus_L" dnl Determine whether the user wants rpath handling at all. AC_ARG_ENABLE([rpath], [ --disable-rpath do not hardcode runtime library paths], :, enable_rpath=yes) ]) dnl AC_LIB_FROMPACKAGE(name, package) dnl declares that libname comes from the given package. The configure file dnl will then not have a --with-libname-prefix option but a dnl --with-package-prefix option. Several libraries can come from the same dnl package. This declaration must occur before an AC_LIB_LINKFLAGS or similar dnl macro call that searches for libname. AC_DEFUN([AC_LIB_FROMPACKAGE], [ pushdef([NAME],[m4_translit([$1],[abcdefghijklmnopqrstuvwxyz./+-], [ABCDEFGHIJKLMNOPQRSTUVWXYZ____])]) define([acl_frompackage_]NAME, [$2]) popdef([NAME]) pushdef([PACK],[$2]) pushdef([PACKUP],[m4_translit(PACK,[abcdefghijklmnopqrstuvwxyz./+-], [ABCDEFGHIJKLMNOPQRSTUVWXYZ____])]) define([acl_libsinpackage_]PACKUP, m4_ifdef([acl_libsinpackage_]PACKUP, [m4_defn([acl_libsinpackage_]PACKUP)[, ]],)[lib$1]) popdef([PACKUP]) popdef([PACK]) ]) dnl AC_LIB_LINKFLAGS_BODY(name [, dependencies]) searches for libname and dnl the libraries corresponding to explicit and implicit dependencies. dnl Sets the LIB${NAME}, LTLIB${NAME} and INC${NAME} variables. dnl Also, sets the LIB${NAME}_PREFIX variable to nonempty if libname was found dnl in ${LIB${NAME}_PREFIX}/$acl_libdirstem. AC_DEFUN([AC_LIB_LINKFLAGS_BODY], [ AC_REQUIRE([AC_LIB_PREPARE_MULTILIB]) pushdef([NAME],[m4_translit([$1],[abcdefghijklmnopqrstuvwxyz./+-], [ABCDEFGHIJKLMNOPQRSTUVWXYZ____])]) pushdef([PACK],[m4_ifdef([acl_frompackage_]NAME, [acl_frompackage_]NAME, lib[$1])]) pushdef([PACKUP],[m4_translit(PACK,[abcdefghijklmnopqrstuvwxyz./+-], [ABCDEFGHIJKLMNOPQRSTUVWXYZ____])]) pushdef([PACKLIBS],[m4_ifdef([acl_frompackage_]NAME, [acl_libsinpackage_]PACKUP, lib[$1])]) dnl Autoconf >= 2.61 supports dots in --with options. pushdef([P_A_C_K],[m4_if(m4_version_compare(m4_defn([m4_PACKAGE_VERSION]),[2.61]),[-1],[m4_translit(PACK,[.],[_])],PACK)]) dnl By default, look in $includedir and $libdir. use_additional=yes AC_LIB_WITH_FINAL_PREFIX([ eval additional_includedir=\"$includedir\" eval additional_libdir=\"$libdir\" ]) AC_ARG_WITH(P_A_C_K[-prefix], [[ --with-]]P_A_C_K[[-prefix[=DIR] search for ]PACKLIBS[ in DIR/include and DIR/lib --without-]]P_A_C_K[[-prefix don't search for ]PACKLIBS[ in includedir and libdir]], [ if test "X$withval" = "Xno"; then use_additional=no else if test "X$withval" = "X"; then AC_LIB_WITH_FINAL_PREFIX([ eval additional_includedir=\"$includedir\" eval additional_libdir=\"$libdir\" ]) else additional_includedir="$withval/include" additional_libdir="$withval/$acl_libdirstem" if test "$acl_libdirstem2" != "$acl_libdirstem" \ && ! test -d "$withval/$acl_libdirstem"; then additional_libdir="$withval/$acl_libdirstem2" fi fi fi ]) dnl Search the library and its dependencies in $additional_libdir and dnl $LDFLAGS. Using breadth-first-seach. LIB[]NAME= LTLIB[]NAME= INC[]NAME= LIB[]NAME[]_PREFIX= dnl HAVE_LIB${NAME} is an indicator that LIB${NAME}, LTLIB${NAME} have been dnl computed. So it has to be reset here. HAVE_LIB[]NAME= rpathdirs= ltrpathdirs= names_already_handled= names_next_round='$1 $2' while test -n "$names_next_round"; do names_this_round="$names_next_round" names_next_round= for name in $names_this_round; do already_handled= for n in $names_already_handled; do if test "$n" = "$name"; then already_handled=yes break fi done if test -z "$already_handled"; then names_already_handled="$names_already_handled $name" dnl See if it was already located by an earlier AC_LIB_LINKFLAGS dnl or AC_LIB_HAVE_LINKFLAGS call. uppername=`echo "$name" | sed -e 'y|abcdefghijklmnopqrstuvwxyz./+-|ABCDEFGHIJKLMNOPQRSTUVWXYZ____|'` eval value=\"\$HAVE_LIB$uppername\" if test -n "$value"; then if test "$value" = yes; then eval value=\"\$LIB$uppername\" test -z "$value" || LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }$value" eval value=\"\$LTLIB$uppername\" test -z "$value" || LTLIB[]NAME="${LTLIB[]NAME}${LTLIB[]NAME:+ }$value" else dnl An earlier call to AC_LIB_HAVE_LINKFLAGS has determined dnl that this library doesn't exist. So just drop it. : fi else dnl Search the library lib$name in $additional_libdir and $LDFLAGS dnl and the already constructed $LIBNAME/$LTLIBNAME. found_dir= found_la= found_so= found_a= eval libname=\"$acl_libname_spec\" # typically: libname=lib$name if test -n "$acl_shlibext"; then shrext=".$acl_shlibext" # typically: shrext=.so else shrext= fi if test $use_additional = yes; then dir="$additional_libdir" dnl The same code as in the loop below: dnl First look for a shared library. if test -n "$acl_shlibext"; then if test -f "$dir/$libname$shrext"; then found_dir="$dir" found_so="$dir/$libname$shrext" else if test "$acl_library_names_spec" = '$libname$shrext$versuffix'; then ver=`(cd "$dir" && \ for f in "$libname$shrext".*; do echo "$f"; done \ | sed -e "s,^$libname$shrext\\\\.,," \ | sort -t '.' -n -r -k1,1 -k2,2 -k3,3 -k4,4 -k5,5 \ | sed 1q ) 2>/dev/null` if test -n "$ver" && test -f "$dir/$libname$shrext.$ver"; then found_dir="$dir" found_so="$dir/$libname$shrext.$ver" fi else eval library_names=\"$acl_library_names_spec\" for f in $library_names; do if test -f "$dir/$f"; then found_dir="$dir" found_so="$dir/$f" break fi done fi fi fi dnl Then look for a static library. if test "X$found_dir" = "X"; then if test -f "$dir/$libname.$acl_libext"; then found_dir="$dir" found_a="$dir/$libname.$acl_libext" fi fi if test "X$found_dir" != "X"; then if test -f "$dir/$libname.la"; then found_la="$dir/$libname.la" fi fi fi if test "X$found_dir" = "X"; then for x in $LDFLAGS $LTLIB[]NAME; do AC_LIB_WITH_FINAL_PREFIX([eval x=\"$x\"]) case "$x" in -L*) dir=`echo "X$x" | sed -e 's/^X-L//'` dnl First look for a shared library. if test -n "$acl_shlibext"; then if test -f "$dir/$libname$shrext"; then found_dir="$dir" found_so="$dir/$libname$shrext" else if test "$acl_library_names_spec" = '$libname$shrext$versuffix'; then ver=`(cd "$dir" && \ for f in "$libname$shrext".*; do echo "$f"; done \ | sed -e "s,^$libname$shrext\\\\.,," \ | sort -t '.' -n -r -k1,1 -k2,2 -k3,3 -k4,4 -k5,5 \ | sed 1q ) 2>/dev/null` if test -n "$ver" && test -f "$dir/$libname$shrext.$ver"; then found_dir="$dir" found_so="$dir/$libname$shrext.$ver" fi else eval library_names=\"$acl_library_names_spec\" for f in $library_names; do if test -f "$dir/$f"; then found_dir="$dir" found_so="$dir/$f" break fi done fi fi fi dnl Then look for a static library. if test "X$found_dir" = "X"; then if test -f "$dir/$libname.$acl_libext"; then found_dir="$dir" found_a="$dir/$libname.$acl_libext" fi fi if test "X$found_dir" != "X"; then if test -f "$dir/$libname.la"; then found_la="$dir/$libname.la" fi fi ;; esac if test "X$found_dir" != "X"; then break fi done fi if test "X$found_dir" != "X"; then dnl Found the library. LTLIB[]NAME="${LTLIB[]NAME}${LTLIB[]NAME:+ }-L$found_dir -l$name" if test "X$found_so" != "X"; then dnl Linking with a shared library. We attempt to hardcode its dnl directory into the executable's runpath, unless it's the dnl standard /usr/lib. if test "$enable_rpath" = no \ || test "X$found_dir" = "X/usr/$acl_libdirstem" \ || test "X$found_dir" = "X/usr/$acl_libdirstem2"; then dnl No hardcoding is needed. LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }$found_so" else dnl Use an explicit option to hardcode DIR into the resulting dnl binary. dnl Potentially add DIR to ltrpathdirs. dnl The ltrpathdirs will be appended to $LTLIBNAME at the end. haveit= for x in $ltrpathdirs; do if test "X$x" = "X$found_dir"; then haveit=yes break fi done if test -z "$haveit"; then ltrpathdirs="$ltrpathdirs $found_dir" fi dnl The hardcoding into $LIBNAME is system dependent. if test "$acl_hardcode_direct" = yes; then dnl Using DIR/libNAME.so during linking hardcodes DIR into the dnl resulting binary. LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }$found_so" else if test -n "$acl_hardcode_libdir_flag_spec" && test "$acl_hardcode_minus_L" = no; then dnl Use an explicit option to hardcode DIR into the resulting dnl binary. LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }$found_so" dnl Potentially add DIR to rpathdirs. dnl The rpathdirs will be appended to $LIBNAME at the end. haveit= for x in $rpathdirs; do if test "X$x" = "X$found_dir"; then haveit=yes break fi done if test -z "$haveit"; then rpathdirs="$rpathdirs $found_dir" fi else dnl Rely on "-L$found_dir". dnl But don't add it if it's already contained in the LDFLAGS dnl or the already constructed $LIBNAME haveit= for x in $LDFLAGS $LIB[]NAME; do AC_LIB_WITH_FINAL_PREFIX([eval x=\"$x\"]) if test "X$x" = "X-L$found_dir"; then haveit=yes break fi done if test -z "$haveit"; then LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }-L$found_dir" fi if test "$acl_hardcode_minus_L" != no; then dnl FIXME: Not sure whether we should use dnl "-L$found_dir -l$name" or "-L$found_dir $found_so" dnl here. LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }$found_so" else dnl We cannot use $acl_hardcode_runpath_var and LD_RUN_PATH dnl here, because this doesn't fit in flags passed to the dnl compiler. So give up. No hardcoding. This affects only dnl very old systems. dnl FIXME: Not sure whether we should use dnl "-L$found_dir -l$name" or "-L$found_dir $found_so" dnl here. LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }-l$name" fi fi fi fi else if test "X$found_a" != "X"; then dnl Linking with a static library. LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }$found_a" else dnl We shouldn't come here, but anyway it's good to have a dnl fallback. LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }-L$found_dir -l$name" fi fi dnl Assume the include files are nearby. additional_includedir= case "$found_dir" in */$acl_libdirstem | */$acl_libdirstem/) basedir=`echo "X$found_dir" | sed -e 's,^X,,' -e "s,/$acl_libdirstem/"'*$,,'` if test "$name" = '$1'; then LIB[]NAME[]_PREFIX="$basedir" fi additional_includedir="$basedir/include" ;; */$acl_libdirstem2 | */$acl_libdirstem2/) basedir=`echo "X$found_dir" | sed -e 's,^X,,' -e "s,/$acl_libdirstem2/"'*$,,'` if test "$name" = '$1'; then LIB[]NAME[]_PREFIX="$basedir" fi additional_includedir="$basedir/include" ;; esac if test "X$additional_includedir" != "X"; then dnl Potentially add $additional_includedir to $INCNAME. dnl But don't add it dnl 1. if it's the standard /usr/include, dnl 2. if it's /usr/local/include and we are using GCC on Linux, dnl 3. if it's already present in $CPPFLAGS or the already dnl constructed $INCNAME, dnl 4. if it doesn't exist as a directory. if test "X$additional_includedir" != "X/usr/include"; then haveit= if test "X$additional_includedir" = "X/usr/local/include"; then if test -n "$GCC"; then case $host_os in linux* | gnu* | k*bsd*-gnu) haveit=yes;; esac fi fi if test -z "$haveit"; then for x in $CPPFLAGS $INC[]NAME; do AC_LIB_WITH_FINAL_PREFIX([eval x=\"$x\"]) if test "X$x" = "X-I$additional_includedir"; then haveit=yes break fi done if test -z "$haveit"; then if test -d "$additional_includedir"; then dnl Really add $additional_includedir to $INCNAME. INC[]NAME="${INC[]NAME}${INC[]NAME:+ }-I$additional_includedir" fi fi fi fi fi dnl Look for dependencies. if test -n "$found_la"; then dnl Read the .la file. It defines the variables dnl dlname, library_names, old_library, dependency_libs, current, dnl age, revision, installed, dlopen, dlpreopen, libdir. save_libdir="$libdir" case "$found_la" in */* | *\\*) . "$found_la" ;; *) . "./$found_la" ;; esac libdir="$save_libdir" dnl We use only dependency_libs. for dep in $dependency_libs; do case "$dep" in -L*) additional_libdir=`echo "X$dep" | sed -e 's/^X-L//'` dnl Potentially add $additional_libdir to $LIBNAME and $LTLIBNAME. dnl But don't add it dnl 1. if it's the standard /usr/lib, dnl 2. if it's /usr/local/lib and we are using GCC on Linux, dnl 3. if it's already present in $LDFLAGS or the already dnl constructed $LIBNAME, dnl 4. if it doesn't exist as a directory. if test "X$additional_libdir" != "X/usr/$acl_libdirstem" \ && test "X$additional_libdir" != "X/usr/$acl_libdirstem2"; then haveit= if test "X$additional_libdir" = "X/usr/local/$acl_libdirstem" \ || test "X$additional_libdir" = "X/usr/local/$acl_libdirstem2"; then if test -n "$GCC"; then case $host_os in linux* | gnu* | k*bsd*-gnu) haveit=yes;; esac fi fi if test -z "$haveit"; then haveit= for x in $LDFLAGS $LIB[]NAME; do AC_LIB_WITH_FINAL_PREFIX([eval x=\"$x\"]) if test "X$x" = "X-L$additional_libdir"; then haveit=yes break fi done if test -z "$haveit"; then if test -d "$additional_libdir"; then dnl Really add $additional_libdir to $LIBNAME. LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }-L$additional_libdir" fi fi haveit= for x in $LDFLAGS $LTLIB[]NAME; do AC_LIB_WITH_FINAL_PREFIX([eval x=\"$x\"]) if test "X$x" = "X-L$additional_libdir"; then haveit=yes break fi done if test -z "$haveit"; then if test -d "$additional_libdir"; then dnl Really add $additional_libdir to $LTLIBNAME. LTLIB[]NAME="${LTLIB[]NAME}${LTLIB[]NAME:+ }-L$additional_libdir" fi fi fi fi ;; -R*) dir=`echo "X$dep" | sed -e 's/^X-R//'` if test "$enable_rpath" != no; then dnl Potentially add DIR to rpathdirs. dnl The rpathdirs will be appended to $LIBNAME at the end. haveit= for x in $rpathdirs; do if test "X$x" = "X$dir"; then haveit=yes break fi done if test -z "$haveit"; then rpathdirs="$rpathdirs $dir" fi dnl Potentially add DIR to ltrpathdirs. dnl The ltrpathdirs will be appended to $LTLIBNAME at the end. haveit= for x in $ltrpathdirs; do if test "X$x" = "X$dir"; then haveit=yes break fi done if test -z "$haveit"; then ltrpathdirs="$ltrpathdirs $dir" fi fi ;; -l*) dnl Handle this in the next round. names_next_round="$names_next_round "`echo "X$dep" | sed -e 's/^X-l//'` ;; *.la) dnl Handle this in the next round. Throw away the .la's dnl directory; it is already contained in a preceding -L dnl option. names_next_round="$names_next_round "`echo "X$dep" | sed -e 's,^X.*/,,' -e 's,^lib,,' -e 's,\.la$,,'` ;; *) dnl Most likely an immediate library name. LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }$dep" LTLIB[]NAME="${LTLIB[]NAME}${LTLIB[]NAME:+ }$dep" ;; esac done fi else dnl Didn't find the library; assume it is in the system directories dnl known to the linker and runtime loader. (All the system dnl directories known to the linker should also be known to the dnl runtime loader, otherwise the system is severely misconfigured.) LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }-l$name" LTLIB[]NAME="${LTLIB[]NAME}${LTLIB[]NAME:+ }-l$name" fi fi fi done done if test "X$rpathdirs" != "X"; then if test -n "$acl_hardcode_libdir_separator"; then dnl Weird platform: only the last -rpath option counts, the user must dnl pass all path elements in one option. We can arrange that for a dnl single library, but not when more than one $LIBNAMEs are used. alldirs= for found_dir in $rpathdirs; do alldirs="${alldirs}${alldirs:+$acl_hardcode_libdir_separator}$found_dir" done dnl Note: acl_hardcode_libdir_flag_spec uses $libdir and $wl. acl_save_libdir="$libdir" libdir="$alldirs" eval flag=\"$acl_hardcode_libdir_flag_spec\" libdir="$acl_save_libdir" LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }$flag" else dnl The -rpath options are cumulative. for found_dir in $rpathdirs; do acl_save_libdir="$libdir" libdir="$found_dir" eval flag=\"$acl_hardcode_libdir_flag_spec\" libdir="$acl_save_libdir" LIB[]NAME="${LIB[]NAME}${LIB[]NAME:+ }$flag" done fi fi if test "X$ltrpathdirs" != "X"; then dnl When using libtool, the option that works for both libraries and dnl executables is -R. The -R options are cumulative. for found_dir in $ltrpathdirs; do LTLIB[]NAME="${LTLIB[]NAME}${LTLIB[]NAME:+ }-R$found_dir" done fi popdef([P_A_C_K]) popdef([PACKLIBS]) popdef([PACKUP]) popdef([PACK]) popdef([NAME]) ]) dnl AC_LIB_APPENDTOVAR(VAR, CONTENTS) appends the elements of CONTENTS to VAR, dnl unless already present in VAR. dnl Works only for CPPFLAGS, not for LIB* variables because that sometimes dnl contains two or three consecutive elements that belong together. AC_DEFUN([AC_LIB_APPENDTOVAR], [ for element in [$2]; do haveit= for x in $[$1]; do AC_LIB_WITH_FINAL_PREFIX([eval x=\"$x\"]) if test "X$x" = "X$element"; then haveit=yes break fi done if test -z "$haveit"; then [$1]="${[$1]}${[$1]:+ }$element" fi done ]) dnl For those cases where a variable contains several -L and -l options dnl referring to unknown libraries and directories, this macro determines the dnl necessary additional linker options for the runtime path. dnl AC_LIB_LINKFLAGS_FROM_LIBS([LDADDVAR], [LIBSVALUE], [USE-LIBTOOL]) dnl sets LDADDVAR to linker options needed together with LIBSVALUE. dnl If USE-LIBTOOL evaluates to non-empty, linking with libtool is assumed, dnl otherwise linking without libtool is assumed. AC_DEFUN([AC_LIB_LINKFLAGS_FROM_LIBS], [ AC_REQUIRE([AC_LIB_RPATH]) AC_REQUIRE([AC_LIB_PREPARE_MULTILIB]) $1= if test "$enable_rpath" != no; then if test -n "$acl_hardcode_libdir_flag_spec" && test "$acl_hardcode_minus_L" = no; then dnl Use an explicit option to hardcode directories into the resulting dnl binary. rpathdirs= next= for opt in $2; do if test -n "$next"; then dir="$next" dnl No need to hardcode the standard /usr/lib. if test "X$dir" != "X/usr/$acl_libdirstem" \ && test "X$dir" != "X/usr/$acl_libdirstem2"; then rpathdirs="$rpathdirs $dir" fi next= else case $opt in -L) next=yes ;; -L*) dir=`echo "X$opt" | sed -e 's,^X-L,,'` dnl No need to hardcode the standard /usr/lib. if test "X$dir" != "X/usr/$acl_libdirstem" \ && test "X$dir" != "X/usr/$acl_libdirstem2"; then rpathdirs="$rpathdirs $dir" fi next= ;; *) next= ;; esac fi done if test "X$rpathdirs" != "X"; then if test -n ""$3""; then dnl libtool is used for linking. Use -R options. for dir in $rpathdirs; do $1="${$1}${$1:+ }-R$dir" done else dnl The linker is used for linking directly. if test -n "$acl_hardcode_libdir_separator"; then dnl Weird platform: only the last -rpath option counts, the user dnl must pass all path elements in one option. alldirs= for dir in $rpathdirs; do alldirs="${alldirs}${alldirs:+$acl_hardcode_libdir_separator}$dir" done acl_save_libdir="$libdir" libdir="$alldirs" eval flag=\"$acl_hardcode_libdir_flag_spec\" libdir="$acl_save_libdir" $1="$flag" else dnl The -rpath options are cumulative. for dir in $rpathdirs; do acl_save_libdir="$libdir" libdir="$dir" eval flag=\"$acl_hardcode_libdir_flag_spec\" libdir="$acl_save_libdir" $1="${$1}${$1:+ }$flag" done fi fi fi fi fi AC_SUBST([$1]) ]) guile-ssh-0.18.0/build-aux/m4/lib-prefix.m4000066400000000000000000000204221471416131000202130ustar00rootroot00000000000000# lib-prefix.m4 serial 7 (gettext-0.18) dnl Copyright (C) 2001-2005, 2008-2016 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, dnl with or without modifications, as long as this notice is preserved. dnl From Bruno Haible. dnl AC_LIB_ARG_WITH is synonymous to AC_ARG_WITH in autoconf-2.13, and dnl similar to AC_ARG_WITH in autoconf 2.52...2.57 except that is doesn't dnl require excessive bracketing. ifdef([AC_HELP_STRING], [AC_DEFUN([AC_LIB_ARG_WITH], [AC_ARG_WITH([$1],[[$2]],[$3],[$4])])], [AC_DEFUN([AC_][LIB_ARG_WITH], [AC_ARG_WITH([$1],[$2],[$3],[$4])])]) dnl AC_LIB_PREFIX adds to the CPPFLAGS and LDFLAGS the flags that are needed dnl to access previously installed libraries. The basic assumption is that dnl a user will want packages to use other packages he previously installed dnl with the same --prefix option. dnl This macro is not needed if only AC_LIB_LINKFLAGS is used to locate dnl libraries, but is otherwise very convenient. AC_DEFUN([AC_LIB_PREFIX], [ AC_BEFORE([$0], [AC_LIB_LINKFLAGS]) AC_REQUIRE([AC_PROG_CC]) AC_REQUIRE([AC_CANONICAL_HOST]) AC_REQUIRE([AC_LIB_PREPARE_MULTILIB]) AC_REQUIRE([AC_LIB_PREPARE_PREFIX]) dnl By default, look in $includedir and $libdir. use_additional=yes AC_LIB_WITH_FINAL_PREFIX([ eval additional_includedir=\"$includedir\" eval additional_libdir=\"$libdir\" ]) AC_LIB_ARG_WITH([lib-prefix], [ --with-lib-prefix[=DIR] search for libraries in DIR/include and DIR/lib --without-lib-prefix don't search for libraries in includedir and libdir], [ if test "X$withval" = "Xno"; then use_additional=no else if test "X$withval" = "X"; then AC_LIB_WITH_FINAL_PREFIX([ eval additional_includedir=\"$includedir\" eval additional_libdir=\"$libdir\" ]) else additional_includedir="$withval/include" additional_libdir="$withval/$acl_libdirstem" fi fi ]) if test $use_additional = yes; then dnl Potentially add $additional_includedir to $CPPFLAGS. dnl But don't add it dnl 1. if it's the standard /usr/include, dnl 2. if it's already present in $CPPFLAGS, dnl 3. if it's /usr/local/include and we are using GCC on Linux, dnl 4. if it doesn't exist as a directory. if test "X$additional_includedir" != "X/usr/include"; then haveit= for x in $CPPFLAGS; do AC_LIB_WITH_FINAL_PREFIX([eval x=\"$x\"]) if test "X$x" = "X-I$additional_includedir"; then haveit=yes break fi done if test -z "$haveit"; then if test "X$additional_includedir" = "X/usr/local/include"; then if test -n "$GCC"; then case $host_os in linux* | gnu* | k*bsd*-gnu) haveit=yes;; esac fi fi if test -z "$haveit"; then if test -d "$additional_includedir"; then dnl Really add $additional_includedir to $CPPFLAGS. CPPFLAGS="${CPPFLAGS}${CPPFLAGS:+ }-I$additional_includedir" fi fi fi fi dnl Potentially add $additional_libdir to $LDFLAGS. dnl But don't add it dnl 1. if it's the standard /usr/lib, dnl 2. if it's already present in $LDFLAGS, dnl 3. if it's /usr/local/lib and we are using GCC on Linux, dnl 4. if it doesn't exist as a directory. if test "X$additional_libdir" != "X/usr/$acl_libdirstem"; then haveit= for x in $LDFLAGS; do AC_LIB_WITH_FINAL_PREFIX([eval x=\"$x\"]) if test "X$x" = "X-L$additional_libdir"; then haveit=yes break fi done if test -z "$haveit"; then if test "X$additional_libdir" = "X/usr/local/$acl_libdirstem"; then if test -n "$GCC"; then case $host_os in linux*) haveit=yes;; esac fi fi if test -z "$haveit"; then if test -d "$additional_libdir"; then dnl Really add $additional_libdir to $LDFLAGS. LDFLAGS="${LDFLAGS}${LDFLAGS:+ }-L$additional_libdir" fi fi fi fi fi ]) dnl AC_LIB_PREPARE_PREFIX creates variables acl_final_prefix, dnl acl_final_exec_prefix, containing the values to which $prefix and dnl $exec_prefix will expand at the end of the configure script. AC_DEFUN([AC_LIB_PREPARE_PREFIX], [ dnl Unfortunately, prefix and exec_prefix get only finally determined dnl at the end of configure. if test "X$prefix" = "XNONE"; then acl_final_prefix="$ac_default_prefix" else acl_final_prefix="$prefix" fi if test "X$exec_prefix" = "XNONE"; then acl_final_exec_prefix='${prefix}' else acl_final_exec_prefix="$exec_prefix" fi acl_save_prefix="$prefix" prefix="$acl_final_prefix" eval acl_final_exec_prefix=\"$acl_final_exec_prefix\" prefix="$acl_save_prefix" ]) dnl AC_LIB_WITH_FINAL_PREFIX([statement]) evaluates statement, with the dnl variables prefix and exec_prefix bound to the values they will have dnl at the end of the configure script. AC_DEFUN([AC_LIB_WITH_FINAL_PREFIX], [ acl_save_prefix="$prefix" prefix="$acl_final_prefix" acl_save_exec_prefix="$exec_prefix" exec_prefix="$acl_final_exec_prefix" $1 exec_prefix="$acl_save_exec_prefix" prefix="$acl_save_prefix" ]) dnl AC_LIB_PREPARE_MULTILIB creates dnl - a variable acl_libdirstem, containing the basename of the libdir, either dnl "lib" or "lib64" or "lib/64", dnl - a variable acl_libdirstem2, as a secondary possible value for dnl acl_libdirstem, either the same as acl_libdirstem or "lib/sparcv9" or dnl "lib/amd64". AC_DEFUN([AC_LIB_PREPARE_MULTILIB], [ dnl There is no formal standard regarding lib and lib64. dnl On glibc systems, the current practice is that on a system supporting dnl 32-bit and 64-bit instruction sets or ABIs, 64-bit libraries go under dnl $prefix/lib64 and 32-bit libraries go under $prefix/lib. We determine dnl the compiler's default mode by looking at the compiler's library search dnl path. If at least one of its elements ends in /lib64 or points to a dnl directory whose absolute pathname ends in /lib64, we assume a 64-bit ABI. dnl Otherwise we use the default, namely "lib". dnl On Solaris systems, the current practice is that on a system supporting dnl 32-bit and 64-bit instruction sets or ABIs, 64-bit libraries go under dnl $prefix/lib/64 (which is a symlink to either $prefix/lib/sparcv9 or dnl $prefix/lib/amd64) and 32-bit libraries go under $prefix/lib. AC_REQUIRE([AC_CANONICAL_HOST]) acl_libdirstem=lib acl_libdirstem2= case "$host_os" in solaris*) dnl See Solaris 10 Software Developer Collection > Solaris 64-bit Developer's Guide > The Development Environment dnl . dnl "Portable Makefiles should refer to any library directories using the 64 symbolic link." dnl But we want to recognize the sparcv9 or amd64 subdirectory also if the dnl symlink is missing, so we set acl_libdirstem2 too. AC_CACHE_CHECK([for 64-bit host], [gl_cv_solaris_64bit], [AC_EGREP_CPP([sixtyfour bits], [ #ifdef _LP64 sixtyfour bits #endif ], [gl_cv_solaris_64bit=yes], [gl_cv_solaris_64bit=no]) ]) if test $gl_cv_solaris_64bit = yes; then acl_libdirstem=lib/64 case "$host_cpu" in sparc*) acl_libdirstem2=lib/sparcv9 ;; i*86 | x86_64) acl_libdirstem2=lib/amd64 ;; esac fi ;; *) searchpath=`(LC_ALL=C $CC -print-search-dirs) 2>/dev/null | sed -n -e 's,^libraries: ,,p' | sed -e 's,^=,,'` if test -n "$searchpath"; then acl_save_IFS="${IFS= }"; IFS=":" for searchdir in $searchpath; do if test -d "$searchdir"; then case "$searchdir" in */lib64/ | */lib64 ) acl_libdirstem=lib64 ;; */../ | */.. ) # Better ignore directories of this form. They are misleading. ;; *) searchdir=`cd "$searchdir" && pwd` case "$searchdir" in */lib64 ) acl_libdirstem=lib64 ;; esac ;; esac fi done IFS="$acl_save_IFS" fi ;; esac test -n "$acl_libdirstem2" || acl_libdirstem2="$acl_libdirstem" ]) guile-ssh-0.18.0/configure.ac000066400000000000000000000155331471416131000157730ustar00rootroot00000000000000dnl configuration script for Guile-SSH dnl Process this file with autoconf to produce configure. dnl define(GUILE_SSH_CONFIGURE_COPYRIGHT, [[ Copyright (C) 2013-2024 Artyom V. Poptsov This file is part of Guile-SSH. Guile-SSH 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 3 of the License, or (at your option) any later version. Guile-SSH 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 Guile-SSH. If not, see . ]]) AC_INIT([Guile-SSH], [0.18.0], [poptsov.artyom@gmail.com], [guile-ssh], [https://github.com/artyom-poptsov/guile-ssh]) AC_COPYRIGHT(GUILE_SSH_CONFIGURE_COPYRIGHT) dnl See dnl LIBGUILE_SSH_INTERFACE="18:0:0" AC_SUBST(LIBGUILE_SSH_INTERFACE) AC_CONFIG_AUX_DIR([build-aux]) AC_CONFIG_MACRO_DIR([build-aux/m4]) AC_CONFIG_HEADER([libguile-ssh/config.h]) AM_INIT_AUTOMAKE([color-tests]) m4_ifdef([AM_SILENT_RULES], [AM_SILENT_RULES([yes])], [AC_SUBST([AM_DEFAULT_VERBOSITY],1)]) AC_PROG_CC LT_INIT([disable-static]) if test "x$GCC" = "xyes"; then # Use compiler warnings. WARN_CFLAGS="-Wall" else WARN_CFLAGS="" fi AC_SUBST([WARN_CFLAGS]) AC_ARG_WITH([guilesitedir], [AS_HELP_STRING([--with-guilesitedir], [use the specified installation path for Guile modules])], [case "x$withval" in xyes|xno) guilesitedir="";; *) guilesitedir="$withval";; esac], [guilesitedir=""]) AC_ARG_ENABLE([dsa], [AS_HELP_STRING([--enable-dsa], [Enable DSA support.])]) AS_IF([test "x$enable_dsa" = "xyes"], [ AC_DEFINE(ENABLE_DSA, 1, [Enable DSA support.]) ], [ AC_DEFINE(ENABLE_DSA, 0, [Disable DSA support.]) ]) AM_CONDITIONAL(ENABLE_DSA, $ENABLE_DSA) # ------------------------------------------------------------------------------- # Check for needed libraries # ------------------------------------------------------------------------------- dnl Checking for libssh 0.8.x. PKG_CHECK_MODULES( [LIBSSH_0_8], [libssh >= 0.8.0], [AC_DEFINE(HAVE_LIBSSH_0_8, 1, [Use libssh 0.8])], [AC_DEFINE(HAVE_LIBSSH_0_8, 0, [Use libssh < 0.8])]) AM_CONDITIONAL(HAVE_LIBSSH_0_8, $HAVE_LIBSSH_0_8) dnl NOTE that Ubuntu 18.04 LTS have "fake" libssh 0.8 dnl (0.8.0~20170825.94fa1e38-1ubuntu0.6) that is actually 0.7, so we need to dnl check 0.8.1+ to make sure we have a valid libssh 0.8. PKG_CHECK_MODULES([LIBSSH_0_8_1], [libssh >= 0.8.1], [AC_DEFINE(HAVE_LIBSSH_0_8_1, 1, [Use libssh 0.8.1])], [AC_DEFINE(HAVE_LIBSSH_0_8_1, 0, [Use libssh < 0.8.1])]) AM_CONDITIONAL(HAVE_LIBSSH_0_8_1, $HAVE_LIBSSH_0_8_1) PKG_CHECK_MODULES( [LIBSSH_0_8_3], [libssh >= 0.8.3], [AC_DEFINE(HAVE_LIBSSH_0_8_3, 1, [Use libssh >= 0.8.3])], [AC_DEFINE(HAVE_LIBSSH_0_8_3, 0, [Use libssh < 0.8.3]) AC_WARN([ You are using an old version of libssh; some Guile-SSH API may not work properly. Please upgrade as soon as possible. Support for libssh versions older than 0.8.3 will be dropped in the future Guile-SSH releases. ])]) AM_CONDITIONAL(HAVE_LIBSSH_0_8_3, $HAVE_LIBSSH_0_8_3) PKG_CHECK_MODULES([LIBSSH_0_9], [libssh >= 0.9.0], [AC_DEFINE(HAVE_LIBSSH_0_9, 1, [Use libssh 0.9])], [AC_DEFINE(HAVE_LIBSSH_0_9, 0, [Use libssh < 0.9])]) AM_CONDITIONAL(HAVE_LIBSSH_0_9, $HAVE_LIBSSH_0_9) PKG_CHECK_MODULES([LIBSSH_0_10], [libssh >= 0.10.0], [AC_DEFINE(HAVE_LIBSSH_0_10, 1, [Use libssh 0.10])], [AC_DEFINE(HAVE_LIBSSH_0_10, 0, [Use libssh < 0.10])]) AM_CONDITIONAL(HAVE_LIBSSH_0_10, $HAVE_LIBSSH_0_10) PKG_CHECK_MODULES([LIBSSH_0_11], [libssh >= 0.11.0], [AC_DEFINE(HAVE_LIBSSH_0_11, 1, [Use libssh 0.11])], [AC_DEFINE(HAVE_LIBSSH_0_11, 0, [Use libssh < 0.11])]) AM_CONDITIONAL(HAVE_LIBSSH_0_11, $HAVE_LIBSSH_0_11) # ------------------------------------------------------------------------------- dnl These macros must be provided by guile.m4. m4_pattern_forbid([^GUILE_PKG$]) m4_pattern_forbid([^GUILE_PROGS$]) dnl Use this macro so that 'GUILE_EFFECTIVE_VERSION' is defined here. dnl Try Guile 3.0, then 2.2, and finally 2.0. GUILE_PKG([3.0 2.2 2.0]) GUILE_PROGS GUILE_FLAGS GUILE_SITE_DIR AC_PATH_PROG([guile_snarf], [guile-snarf], [not-found]) if test "x$guile_snarf" = "xnot-found"; then AC_MSG_ERROR([`guile-snarf' not found. Please install Guile 2.x, 3.x or later.]) fi if test "x$GUILD" = "x"; then GUILD=`which guild` AC_SUBST(GUILD) fi dnl (srfi srfi-64) appeared in Guile 2.0.10. Make sure we have it. GUILE_MODULE_AVAILABLE([have_srfi64], [(srfi srfi-64)]) if test "x$have_srfi64" != "xyes"; then AC_MSG_ERROR([(srfi srfi-64) is missing; please install a more recent Guile.]) fi LT_INIT() if test "x$guilesitedir" = "x"; then guilesitedir="$datadir/guile/site/$GUILE_EFFECTIVE_VERSION" fi AC_SUBST([guilesitedir]) GUILE_EFFECTIVE_VERSION=`$GUILE -c '(display (effective-version))'` AC_SUBST(GUILE_EFFECTIVE_VERSION) AC_CONFIG_FILES([Makefile libguile-ssh/Makefile examples/Makefile build-aux/Makefile]) AC_CONFIG_FILES([build-aux/m4/Makefile doc/Makefile tests/Makefile build-aux/am/Makefile]) AC_CONFIG_FILES([modules/Makefile modules/ssh/Makefile modules/ssh/dist/Makefile]) AM_CONDITIONAL([CROSS_COMPILING], [test "x$cross_compiling" = "xyes"]) # Generate a Makefile, based on the results. AC_OUTPUT if test "$guilesitedir" != "$GUILE_SITE"; then # Guile has a different prefix than this module AC_MSG_WARN([] [The Guile modules will be installed in ${guilesitedir}.] [You should probably re-run `configure' with] [`--with-guilesitedir=$GUILE_SITE'] [Otherwise, you will have to adjust the `GUILE_LOAD_PATH' environment] [variable.]) fi AS_IF( [test "x$enable_dsa" = "xyes"], [ AC_MSG_WARN( [] [Guile-SSH is configured with DSA public key algorithm support.] [Note that DSA support is disabled by default in libssh 0.10.] [] [] [If your version of libssh does not support DSA public key algorithm] [it will lead to errors in Guile-SSH.] ) ], [ AC_MSG_NOTICE( [Guile-SSH configured without DSA public key algorithm support.] ) ] ) guile-ssh-0.18.0/doc/000077500000000000000000000000001471416131000142435ustar00rootroot00000000000000guile-ssh-0.18.0/doc/.gitignore000066400000000000000000000001041471416131000162260ustar00rootroot00000000000000# -*- shell-script -*- # Generated files guile-ssh.info stamp-vti guile-ssh-0.18.0/doc/Makefile.am000066400000000000000000000006031471416131000162760ustar00rootroot00000000000000AUTOMAKE_OPTIONS = gnu info_TEXINFOS = guile-ssh.texi guile_ssh_TEXINFOS = \ api-auth.texi \ api-agent.texi \ api-channels.texi \ api-tunnels.texi \ api-keys.texi \ api-messages.texi \ api-servers.texi \ api-sessions.texi \ api-logging.texi \ api-version.texi \ api-dist.texi \ api-sftp.texi \ api-popen.texi \ api-shell.texi \ examples.texi \ fdl.texi \ indices.texi guile-ssh-0.18.0/doc/api-agent.texi000066400000000000000000000045501471416131000170070ustar00rootroot00000000000000@c -*-texinfo-*- @c This file is part of Guile-SSH Reference Manual. @c Copyright (C) 2020-2021 Artyom V. Poptsov @c See the file guile-ssh.texi for copying conditions. @node Agent @section Agent @cindex agent The @code{(ssh agent)} module provides procedures for interacting with SSH authentication agent instances. @c ----------------------------------------------------------------------------- @subsection Starting/stopping SSH agents @deffn {Scheme Procedure} ssh-agent-start Start an OpenSSH agent. Return a list with SSH agent information of the following form: @lisp '((SSH_AUTH_SOCK . ) (SSH_AGENT_PID . )) @end lisp @end deffn @deffn {Scheme Procedure} ssh-agent-stop Kill the current agent (given by the @code{SSH_AGENT_PID} environment variable). @end deffn @c ----------------------------------------------------------------------------- @subsection Getting information about SSH agents @deffn {Scheme Procedure} ssh-agent-info @ [#:user=(getenv "USER")] @ [#:path=(or (getenv "TMPDIR") "/tmp")] The procedure tries to find information about all running SSH authentication agent instances by searching the specified @var{path} for a given @var{user}. The agent subdirectory pattern is used as specified in the @command{ssh-agent} man page: @code{ssh-XXXXXXXXXX/agent.} Returns an associative list of the following form: @lisp '(((SSH_AUTH_SOCK . ) (SSH_AGENT_PID . )) ((SSH_AUTH_SOCK . ) (SSH_AGENT_PID . )) ...) @end lisp One might use the procedure to configure the environment in a REPL to use SSH @code{userauth-agent!} procedure later: @lisp (define s (make-session #:host "localhost")) (connect! s) (ssh-agent-sock-set! (assoc-ref (car (ssh-agent-info)) 'SSH_AUTH_SOCK)) (userauth-agent! s) (with-ssh (make-node s) (version)) @end lisp @end deffn @c ----------------------------------------------------------------------------- @subsection Managing SSH agent environment variables @deffn {Scheme Procedure} ssh-agent-sock-get Get the @env{SSH__AGENT__SOCK} environment variable value. @end deffn @deffn {Scheme Procedure} ssh-agent-sock-set! sock-file Set the value of @env{SSH__AGENT__SOCK} environment variable to the @var{sock-file}. @end deffn @c Local Variables: @c TeX-master: "guile-ssh.texi" @c End: guile-ssh-0.18.0/doc/api-auth.texi000066400000000000000000000110321471416131000166430ustar00rootroot00000000000000@c -*-texinfo-*- @c This file is part of Guile-SSH Reference Manual. @c Copyright (C) 2014 Artyom V. Poptsov @c See the file guile-ssh.texi for copying conditions. @node Auth @section Auth @cindex authentication The @code{(ssh auth)} module provides authentication procedures for a Guile-SSH client. Please note that you must specify a username either on creation of a session or by @code{session-set!} call (@pxref{Sessions}) before calling of procedures from this section. Also @strong{note} that the session must be connected before calling to these procedures, otherwise the @code{wrong-type-arg} exception will be thrown. @deffn {Scheme Procedure} userauth-public-key! session private-key Try to authenticate with a public/private key. Return one of the following symbols: @table @samp @item success Authentication success. @item partial You've been partially authenticated, you still have to use another method. @item denied Authentication failed: use another method. @item error A serious error happened. @end table @end deffn @deffn {Scheme Procedure} userauth-public-key/auto! session @cindex authentication with a SSH agent Try to automatically authenticate with @code{none} method first and then with public keys. The procedure will try to get a cached private key from a @acronym{SSH} agent and if it fails it will try to read a key from a file. If the key is encrypted the user will be asked for a passphrase. Return one of the following symbols: @table @samp @item success Authentication success. @item partial You've been partially authenticated, you still have to use another method. @item denied Authentication failed: use another method. @item error A serious error happened. @end table @end deffn @deffn {Scheme Procedure} userauth-public-key/try session public-key Try to authenticate with the given @var{public-key}. To avoid unnecessary processing and user interaction, the following method is provided for querying whether authentication using the @var{public-key} would be possible. Return one of the following symbols: @table @samp @item success The public key is accepted, you want now to use @code{userauth-public-key!}. @item partial You've been partially authenticated, you still have to use another method. @item denied Authentication failed: use another method. @item error A serious error happened. @end table @end deffn @deffn {Scheme Procedure} userauth-agent! session Try to do public key authentication with ssh agent. Return one of the following symbols: @table @samp @item success Authentication success. @item partial You've been partially authenticated, you still have to use another method. @item denied Authentication failed: use another method. @item error A serious error happened. @end table @end deffn @deffn {Scheme Procedure} userauth-password! session password Try to authenticate by @var{password}. Return one of the following symbols: @table @samp @item success Authentication success. @item partial You've been partially authenticated, you still have to use another method. @item denied Authentication failed: use another method. @item error A serious error happened. @item again In nonblocking mode, you've got to call this again later. @end table @end deffn @deffn {Scheme Procedure} userauth-gssapi! session Try to authenticate through the @code{gssapi-with-mic} method. Return one of the following symbols: @table @samp @item success Authentication success. @item partial You've been partially authenticated, you still have to use another method. @item again In nonblocking mode, you've got to call this again later. @item denied Authentication failed: use another method. @item error A serious error happened. @end table @end deffn @deffn {Scheme Procedure} userauth-none! session Try to authenticate through the @code{none} method. Return one of the following symbols: @table @samp @item success Authentication success. @item partial You've been partially authenticated, you still have to use another method. @item again In nonblocking mode, you've got to call this again later. @item denied Authentication failed: use another method. @item error A serious error happened. @end table @end deffn @deffn {Scheme Procedure} userauth-get-list session Get available authentication methods for a @var{session}. Return list of available methods. This call will block, even in nonblocking mode, if run for the first time before a (complete) call to @code{userauth-none!}. Possible methods are: @code{password}, @code{public-key}, @code{host-based}, @code{interactive}. @end deffn @c Local Variables: @c TeX-master: "guile-ssh.texi" @c End: guile-ssh-0.18.0/doc/api-channels.texi000066400000000000000000000270031471416131000175020ustar00rootroot00000000000000@c -*-texinfo-*- @c This file is part of Guile-SSH Reference Manual. @c Copyright (C) 2014-2021 Artyom V. Poptsov @c See the file guile-ssh.texi for copying conditions. @node Channels @section Channels @menu * Channel Management:: * Port Forwarding:: @end menu @c ----------------------------------------------------------------------------- @node Channel Management @subsection Channel Management @cindex data transferring @tindex channel The @code{(ssh channel)} module provides facilities to create Guile-SSH channels and manipulating of them. Channels are implemented as GNU Guile ports. Therefore they can be used with regular I/O procedures such as @code{display}, @code{write}, @code{read-line} and friends (@pxref{Input and Output,,, guile, The GNU Guile Reference Manual}). This section describes operations that are specific for the channels. When a channel is closed by the remote side, the local side detects it; reading from such channel gives an EOF object when all data is read. Note that when the parent session from which a channel is made is freed the channel is freed as well. @deffn {Scheme Procedure} channel? x Return @code{#t} if @var{x} is a Guile-SSH channel, @code{#f} otherwise. @end deffn @deffn {Scheme Procedure} make-channel session [mode] Allocate a new Guile-SSH channel for the @var{session} (@pxref{Sessions}). @var{flags} are determine what kind of a channel should be created. Possible modes are: @code{OPEN_READ}, @code{OPEN_WRITE}, @code{OPEN_BOTH}. They allow to create either an input channel, output channel or input/output channel respectively. @end deffn @deffn {Scheme Procedure} channel-open-session channel Open a session channel. This procedure actually turn the @var{channel} into an open port available for I/O operations. Throw @code{guile-ssh-error} on error. Return value is undefined. @end deffn @deffn {Scheme Procedure} channel-open? channel Return @code{#t} if a @var{channel} is open, #f otherwise. Note that this procedure also returns @code{#f} when the remote side is closed. @end deffn @deffn {Scheme Procedure} channel-request-exec channel command @cindex non-interactive SSH session @cindex command execution Run a shell @var{command} without an interactive shell. The @var{channel} must be open. Throw @code{guile-ssh-error} on error. Return value is undefined. This procedure is a low-level one and you should use remote pipes instead (@pxref{Remote Pipes}). @strong{Note} that the procedure only can be used to execute a single command on the remote host, so you should close the channel after @code{channel-request-exec}. If you want to execute another command then you must open a new channel and use it. Example: @lisp (let ((channel (make-channel session))) (channel-open-session channel) (channel-request-exec channel "uname") (read-line channel)) @result{} "Linux" @end lisp @end deffn @deffn {Scheme Procedure} channel-request-pty channel Request a @acronym{PTY} (pseudo terminal). Throw @code{guile-ssh-error} on error. The @var{channel} must be open. Return value is undefined. @end deffn @deffn {Scheme Procedure} channel-request-shell channel Request a shell. The @var{channel} must be open. Throw @code{guile-ssh-error} on error. Return value is undefined. @end deffn @deffn {Scheme Procedure} channel-request-env channel variable value @cindex setting of environment variables Set an environment @var{variable} to @var{value}. Throw @code{guile-ssh-error} on error. The @var{channel} must be open. Return value is undefined. @end deffn @deffn {Scheme Procedure} channel-request-send-exit-status channel exit-status Send an @var{exit-status} to the remote process (as described in RFC 4254, section 6.10). Only SSH-v2 is supported. Return value is undefined. The @var{channel} needs to be closed with after this message. @end deffn @deffn {Scheme Procedure} channel-set-pty-size! channel columns rows Change size of the @acronym{PTY} to @var{columns} and @var{rows}. The @var{channel} must be open. Return value is undefined. @end deffn @deffn {Scheme Procedure} channel-set-stream! channel stream Set default @var{stream} for @var{channel}. @var{stream} must be one of the following symbols: @code{stdout} (default), @code{stderr}. The @var{channel} must be open. Throw @code{guile-ssh-error} on error. Return value is undefined. Example: @lisp (channel-set-stream! channel 'stderr) @end lisp @end deffn @deffn {Scheme Procedure} channel-get-stream channel Get current stream name from @var{channel}. The @var{channel} must be open. Throw @code{guile-ssh-error} on error. Return one of the following symbols: @code{stdout}, @code{stderr}. Example: @lisp (channel-get-stream channel) @result{} 'stderr @end lisp @end deffn @deffn {Scheme Procedure} channel-get-session channel Get the session to which belongs the @var{channel}. Throw @code{guile-ssh-error} on an error. Return the session. @end deffn @deffn {Scheme Procedure} channel-send-eof channel Send an end of file (EOF) on the @var{channel}. This action doesn't close the @var{channel}; you may still read from it but not write. Throw @code{guile-ssh-error} on an error. Return value is undefined. Example: @lisp (use-modules (ice-9 rdelim) ;; Guile-SSH modules. (ssh auth) (ssh popen) (ssh session) (ssh channel)) ;; Make a session (define s (make-session #:host "example.org")) ;; Connect to the server (connect! s) ;; Authenticate (userauth-agent! s) ;; Open a remote pipe to 'wc' command running on ;; the server. (let ((p (open-remote-pipe s "wc" OPEN_BOTH))) ;; Send data to 'wc' command using the remote pipe. (display "Hello Scheme World!" p) ;; 'wc' reads data until EOF and writes its result ;; afterwards. (channel-send-eof p) ;; Read the 'wc' output. (read-line p)) @result{} " 0 3 19" @end lisp @end deffn @deffn {Scheme Procedure} channel-eof? channel Return @code{#t} if remote has sent @acronym{EOF}, @code{#f} otherwise. Throw @code{guile-ssh-error} if the channel has been closed and freed. @end deffn @deffn {Scheme Procedure} channel-get-exit-status channel Get the exit status of the @var{channel} (error code from the executed instruction). The @var{channel} must be open. Return the exist status, or @code{#f} if no exit status has been returned (yet). Throw @code{guile-ssh-error} on error. @end deffn @c ----------------------------------------------------------------------------- @node Port Forwarding @subsection Port Forwarding @cindex Port forwarding Low-level API from @code{(ssh channel)} module to manage SSH port forwarding. These procedures @strong{do not} bind the ports and do not automatically forward the content of a socket to the channel. You should either implement binding and data forwarding in your application or use the tunnel API (@pxref{Tunnels, Guile-SSH tunnel API}) @deffn {Scheme Procedure} channel-open-forward channel [#:source-host=''localhost''] #:local-port #:remote-host [#:remote-port=local-port] Open a (local) TCP/IP forwarding @var{channel}. Connect to a @var{remote-host} and @var{remote-port}, and use @var{source-host} and @var{local-port} as origination of connections. The procedure returns one of the following symbols: @table @samp @item ok Success. @item again We are in the nonblocking mode and the call to be done again. @item error An error occurred. @end table The local port forwarding works as follows: @example local-host remote-host ,..............., ,................. : : : : : [a browser] : : [a web server] : : | : : A : : | : : | : : port 8080 : : port 80 : : | : : | : : V : : | : : [SSH client]===========>[SSH server] : : : : : '...............' '................' @end example Where port 8080 is an arbitrary @var{local-port} and port 80 is a @var{remote-port}. Also in our case, ``SSH client'' is an application that uses Guile-SSH and calls @code{channel-open-forward}. Example: @lisp (channel-open-forward channel #:local-port 8080 #:remote-host "www.example.org" #:remote-port 80) @end lisp @end deffn @deffn {Scheme Procedure} channel-listen-forward session [#:address=#f] [#:port=0] Start a TCP/IP reverse (remote) port forwarding. Send the ``tcpip-forward'' global request using @var{session} to ask the server to begin listening for inbound connections on the specified @var{address} and @var{port}. If @var{address} is not specified (or set to @code{#f}) then the server binds all addresses on all protocol families supported by the server. When 0 is passed as a @var{port} then server allocates the next unprivileged port. The procedure returns two values: the first value is the result of the operation, and the second value is the bound port number; if @var{port} was set to 0 then the procedure returns the chosen port number. The result of the operation can be one of the following symbols: @table @samp @item ok Success. @item again We are in the nonblocking mode and the call to be done again. @item error An error occurred. @end table Reverse port forwarding looks as follows: @example local-host remote-host ,................, ,................. : : : : : [a web server] : : [a browser] : : A : : | : : | : : | : : port 80 : : port 8080 : : | : : | : : | : : V : : [SSH client]<===========[SSH server] : : : : : '................' '................' @end example @end deffn @deffn {Scheme Procedure} channel-accept-forward session [timeout=0] Accept an incoming TCP/IP forwarding channel and get information about incoming connection. Return two values: the first value is the incoming channel, and the second value is a port number on which the connection was issued. @end deffn @deffn {Scheme Procedure} channel-cancel-forward session address port Send ``cancel-tcpip-forward'' global request to @var{session} to ask the server to cancel a ``tcpip-forward'' request on the bound @var{address} and @var{port}. The result of the operation can be one of the following symbols: @table @samp @item ok Success. @item again We are in the nonblocking mode and the call to be done again. @item error An error occurred. @end table Here's an example Guile program that uses @code{channel-cancel-forward} to cancel reverse port forwarding on a server: @lisp #!/usr/bin/guile \ -e main !# (use-modules (ssh session) (ssh auth) (ssh channel)) (define (main args) (let ((session (make-session #:user "alice" #:host "127.0.0.1" #:port 22 #:log-verbosity 'rare))) (connect! session) (userauth-agent! session) ;; Send "tcpip-forward" request to an SSH server (channel-listen-forward session #:address "localhost" #:port 12345) ;; Accept incoming reverse port forwarding requests with ;; 'channel-accept-forward' in some kind of loop... ;; Cancel the issued "tcpip-forward" request with ;; "cancel-tcpip-forward" request (channel-cancel-forward session "localhost" 12345))) @end lisp @end deffn @c Local Variables: @c TeX-master: "guile-ssh.texi" @c End: guile-ssh-0.18.0/doc/api-dist.texi000066400000000000000000000234701471416131000166560ustar00rootroot00000000000000@c -*-texinfo-*- @c This file is part of Guile-SSH Reference Manual. @c Copyright (C) 2015-2024 Artyom V. Poptsov @c See the file guile-ssh.texi for copying conditions. @node Distributed Forms @section Distributed Forms @cindex secure distributed computing The @code{(ssh dist)} module provides the spirit of distributed computing for Guile. To make use of the procedures listed in this section you will need an SSH daemon and a GNU Guile @abbr{REPL, Read-Eval-Print Loop} server both running on the remote host. Also note that currently there may be cases in which distributed procedures may fail to (de)serialise data; namely @code{make-vector} is one of such procedures which output may be troublesome for @code{with-ssh}. To overcome this specific case one could pass the @code{fill} argument to @code{make-vector} to fill the newly created vector with the specified filling instead of @code{#}. Node management procedures: @deffn {Scheme Procedure} make-node session Make a new node that uses an SSH @var{session} to connect to a freshly started Guile REPL on the remote side. Return the new @code{} instance. @end deffn @deffn {Scheme Procedure} node? x Return @code{#t} if @var{x} is a node object, @code{#f} otherwise. @end deffn @deffn {Scheme Procedure} node-session node Get underlying SSH session from @var{node}. @end deffn @deffn {Scheme Procedure} node-repl-port node Get REPL port number from a @var{node}. @end deffn @deffn {Scheme Procedure} node-loadavg node Get average load of a @var{node}. Return multiple values. The 1st value is an alist of five elements as described in proc(5) man page. The rest of values are as described in documentation for @code{node-eval} procedure. For example: @lisp (use-modules (ssh auth) (ssh session) (ssh dist node)) (let ((s (make-session #:host "example.org"))) (connect! s) (userauth-agent! s) (let ((n (make-node s))) (node-loadavg n))) @result{} ((one . 0.15) (five . 0.14) (fifteen . 0.16) (scheduling-entities 1 189) (last-pid . 15629)) @result{} 1 @result{} "(guile-user)" @result{} "scheme" @end lisp @end deffn Interaction with remote REPLs: @deffn {Scheme Procedure} distribute nodes expr ... Evaluate each @var{expr} in parallel, using distributed computation. Split the job to nearly equal parts and hand out each of resulting sub-jobs to @var{nodes} list. Return the results of N expressions as a set of N multiple values (@pxref{Multiple Values,,, guile, The GNU Guile Reference Manual}). @end deffn @deffn {Scheme Procedure} dist-map nodes proc lst Do list mapping using distributed computation. Split the work into nearly equal parts and hand out the resulting jobs to @var{nodes} list. Return the result of computation. If for some reason a job could not be executed on a node (for example, if connection to a remote REPL fails), @code{dist-map} transfers the job to another node from the @var{nodes} list. When job execution failed on all nodes, an error is reported. In a case when an error that occurred during job execution is considered non-recoverable (eg. when evaluation of @var{proc} on a node failed due to an unbound variable) then execution of a job stops immediately. @end deffn @deffn {Scheme Procedure} with-ssh node exp ... Evaluate expressions on a remote REPL using a @var{node}, return four values: an evaluation result, a number of the evaluation, a module name and a language name. Throw @code{node-error} or @code{node-repl-error} on an error. Example: @lisp (use-modules (ssh session) (ssh auth) (ssh dist)) (let ((session (make-session #:user "alice" #:host "www.example.org"))) (connect! session) (userauth-agent! session) (display (with-ssh (make-node session) (gethostname))) (newline)) @end lisp If an expression is evaluated to multiple values then the 1st value returned by @code{with-ssh} will be a vector of the evaluated values and the 2nd value will be a vector of evaluation numbers. In this case the 2nd value can be used to check whether @code{with-ssh} body evaluated to multiple values or not. For example: @lisp (use-modules (ssh session) (ssh auth) (ssh dist)) (let ((session (make-session #:user "alice" #:host "www.example.org"))) (connect! session) (userauth-agent! session) (with-ssh (make-node session) (values 1 2))) => #(1 2) => #(39 40) => "(guile-user)" => "scheme" @end lisp @end deffn @deffn {Scheme Procedure} rrepl node Start an interactive remote REPL (RREPL) session using @var{node}. @end deffn @c ----------------------------------------------------------------------------- @subsection Low-level API @subsubsection Nodes @tindex node The module @code{(ssh dist node)} provides low-level API for node management. Here's the description of the format of node type printed representation: @example # A A A A A | | | | | ,---' | ,-' '---. '-----------. | | | | | user host port REPL port object address @end example There are two types of node errors: recoverable and non-recoverable. The first group is represented by @code{node-error} exceptions. If an exception of this kind is occurred then there is a chance that a job can be executed on another node. That's because such an exception occures in cases when a node is unreachable, for example. The second group is represented by @code{node-repl-error} exceptions. Such exceptions mean that an error is occurred during execution of a job on a node's REPL -- eg. due to the malformed job. Those errors are non-recoverable because if the job is broken it will likely fail on another nodes as well. In addition to @code{make-node}, @code{node?}, @code{node-session} and @code{node-repl-port} the module provides: @deffn {Scheme Procedure} node-eval node quoted-exp Evaluate a @var{quoted-exp} on a @var{node} and return four values: an evaluation result, a number of the evaluation, a module name and a language name. Throw @code{node-repl-error} if a non-recoverable error occurred, or @code{node-error} if the evaluation potentially could be succesfully evaluated on another node. @strong{Note} that @url{https://gitlab.com/procps-ng/procps, procps} version 3.3.12 or later is needed on the server side in case of either @code{start-repl-server?} or @code{stop-repl-server?} was set to @code{#t} for a @var{NODE} (see the documentation for @code{make-node}.) @end deffn @deffn {Scheme Procedure} node-open-rrepl node Open a remote REPL (RREPL). Return a new RREPL channel. @end deffn @deffn {Scheme Procedure} node-run-server node Run a REPL server on a @var{node}. Throw @code{node-error} with the current node and the Guile return code from a server on an error. @end deffn @deffn {Scheme Procedure} node-stop-server node Stop a RREPL server on a @var{node}. @end deffn @deffn {Scheme Procedure} node-guile-version node Get Guile version installed on a @var{node}, return the version string. Return @code{#f} if Guile is not installed. @end deffn @deffn {Scheme Procedure} node-server-running? node Check if a REPL server is running on a @var{node}, return @code{#t} if it is running and listens on an expected port, return @code{#f} otherwise. @end deffn @deffn {Scheme Procedure} rrepl-eval rrepl-channel expr Evaluate expression @var{expr} using @var{rrepl-channel}, return four values: an evaluation result, a number of the evaluation, a module name and a language name. Throw @code{node-repl-error} on an error. @end deffn @deffn {Scheme Procedure} rrepl-skip-to-prompt rrepl-channel Read from @var{rrepl-channel} until REPL is observed. Throw @code{node-error} on an error. @end deffn @c ----------------------------------------------------------------------------- @subsubsection Jobs @tindex job The module @code{(ssh dist job)} provides low-level API for job management. Here's the description of the format of node type printed representation: @example # a1345a0> A A A | | | | '----------. | | | | job type node (see above) job object address @end example @deffn {Scheme Procedure} split lst count Split a list @var{lst} into @var{count} chunks. Return a list of chunks. Example: @lisp (split '(a b c d) 2) @result{} '((a b) (c d)) @end lisp @end deffn @deffn {Scheme Procedure} make-job type node data proc Make a new job of @var{type} using @var{node}. @end deffn @deffn {Scheme Procedure} job? x Return @code{#t} if @var{x} is a job object, @code{#f} otherwise. @end deffn @deffn {Scheme Procedure} job-type job Get type of a @var{job}. @end deffn @deffn {Scheme Procedure} job-node job Get a @var{job} node. @end deffn @deffn {Scheme Procedure} set-job-node job node Transfer @var{job} to a new @var{node}. Return a new job object. @end deffn @deffn {Scheme Procedure} job-data job Get a @var{job} data. @end deffn @deffn {Scheme Procedure} job-proc job Get a @var{job} procedure. @end deffn @deffn {Scheme Procedure} assign-eval nodes expressions Split an @var{expressions} list to nearly equal parts according to the length of a @var{nodes} list and assign each evaluation job to a node. Return a list of assigned jobs. @end deffn @deffn {Scheme Procedure} assign-map nodes lst proc Split the work to nearly equal parts according to length of @var{nodes} list and assign each part of work to a node. Return list of assigned jobs. @end deffn @deffn {Scheme Procedure} hand-out-job job Hand out @var{job} to the assigned node and return the result of computation. @end deffn @deffn {Scheme Procedure} job->sexp job Convert a @var{job} to an equivalent symbolic expression. @end deffn @c Local Variables: @c TeX-master: "guile-ssh.texi" @c End: guile-ssh-0.18.0/doc/api-keys.texi000066400000000000000000000110641471416131000166620ustar00rootroot00000000000000@c -*-texinfo-*- @c This file is part of Guile-SSH Reference Manual. @c Copyright (C) 2014-2023 Artyom V. Poptsov @c See the file guile-ssh.texi for copying conditions. @node Keys @section Keys @cindex public keys @cindex private keys @tindex key The @code{(ssh key)} module provides procedures for handling of Guile-SSH keys. @strong{Note} that Guile-SSH does not support ECDSA keys if libssh 0.6.3 is compiled with GCrypt instead of OpenSSL. @deffn {Scheme Procedure} make-keypair type length Generate a keypair of specified @var{type} and @var{length} (in bits). This may take some time. Possible key types are: @code{dss}, @code{rsa}, @code{rsa1}, @code{ecdsa}. Return newly generated private key. Throw @code{guile-ssh-error} on error. @end deffn @deffn {Scheme Procedure} key? x Return @code{#t} if @var{x} is a Guile-SSH key, @code{#f} otherwise. @end deffn @deffn {Scheme Procedure} public-key? x Return @code{#t} if @var{x} is a Guile-SSH key and it @strong{contains} a public key, @code{#f} otherwise. What it means is that the procedure will return @code{#t} for a private key too (because the private key contains a public key in some sense). @end deffn @deffn {Scheme Procedure} private-key? x Return @code{#t} if @var{x} is a Guile-SSH private key, @code{#f} otherwise. @end deffn @deffn {Scheme Procedure} public-key->string public-key Convert @var{public-key} to a string. @end deffn @deffn {Scheme Procedure} string->public-key string type Convert a public key of @var{type} represented as Base64 @var{string} to a Guile-SSH key. Throw @code{guile-ssh-error} on error. The @var{type} must be one of the following symbols: @code{dss}, @code{rsa}, @code{rsa1}, @code{ecdsa} @end deffn @deffn {Scheme Procedure} private-key-from-file @ file @ [#:auth-callback=#f] @ [#:user-data=#f] Read private key from a @var{file}. If the the key is encrypted the user will be asked using @var{auth-callback} for passphrase to decrypt the key. When @var{auth-callback} is called, @var{user-data} is passed to it as an argument. If no @var{auth-callback} is provided then the procedure denies access to an encrypted key. Return a new Guile-SSH key or @code{#f} on error. The procedure performs @var{auth-callback} call as follows: @lisp (auth-callback prompt maximum-password-length echo? verify? user-data) @end lisp Where @code{prompt} is a string that specifies the password prompt to use. The callback must return either a password as a string or @code{#f} if access must be denied. Usage example: @lisp (use-modules (ssh key)) (define (callback prompt max-len echo? verify? user-data) (getpass (format #f "~a: " prompt))) (define key (private-key-from-file (string-append (getenv "HOME") "/.ssh/id_rsa") #:auth-callback callback)) @end lisp @end deffn @deffn {Scheme Procedure} private-key-to-file private-key file-name Export @var{private-key} to a PAM file @var{file-name} on a disk. Throw @code{guile-ssh-error} on error. Return value is undefined. @strong{Note} that this procedure won't work if libssh 0.6.3 is compiled with GCrypt cryptographic library. @end deffn @deffn {Scheme Procedure} private-key->public-key private-key Get a public key from the @var{private-key}. @end deffn @deffn {Scheme Procedure} public-key-from-file session file Read public key from a @var{file}. Return a public key or @code{#f} on error. @end deffn @deffn {Scheme Procedure} get-key-type key Get a symbol that represents the type of the Guile-SSH @var{key}. Possible types are: @code{dss}, @code{rsa}, @code{rsa1}, @code{unknown}. @end deffn @deffn {Scheme Procedure} get-public-key-hash public-key type @cindex fingerprint @tindex fingerprint Get a @var{public-key} hash of @var{type} as a bytevector. Return the bytevector on success, @code{#f} on error. See also @code{get-server-public-key} in @pxref{Sessions}. The @var{type} can be one of the following symbols: @code{md5}, @code{sha1}. Example: @lisp (let ((pubkey (get-server-public-key session))) (get-public-key-hash pubkey 'md5)) @result{} #vu8(15 142 110 203 162 228 250 211 20 212 26 217 118 57 217 66) @end lisp @end deffn @deffn {Scheme Procedure} bytevector->hex-string bv @cindex fingerprint @tindex fingerprint Convert the given bytevector @var{bv} to a colon separated string. Example: @lisp (let ((hash (get-public-key-hash pubkey 'md5))) (bytevector->hex-string hash)) @result{} "0f:8e:6e:cb:a2:e4:fa:d3:14:d4:1a:d9:76:39:d9:42" @end lisp @end deffn @c Local Variables: @c TeX-master: "guile-ssh.texi" @c End: guile-ssh-0.18.0/doc/api-logging.texi000066400000000000000000000070701471416131000173370ustar00rootroot00000000000000@c -*-texinfo-*- @c This file is part of Guile-SSH Reference Manual. @c Copyright (C) 2014 Artyom V. Poptsov @c See the file guile-ssh.texi for copying conditions. @node Logging @section Logging @cindex logging The @code{(ssh log)} module provides procedures to control the libssh logging facilities. @deffn {Scheme Procedure} %default-log-printer priority function message userdata Default callback for printing log messages to the current error port. The procedure comments out log messages with ``;;; `` to make it easier to distinguish libssh traces from Guile-SSH messages in REPL mode. This callback is set by default. @end deffn @deffn {Scheme Procedure} %default-libssh-log-printer priority function message userdata The procedure makes log messages in the same format as the libssh default log formatter. @end deffn @deffn {Scheme Procedure} current-logging-callback Return the current logging callback. Returns a procedure or @code{#f} if the callback is not set. @end deffn @deffn {Scheme Procedure} set-logging-callback! callback Change the current logging callback to @var{callback}. The @var{callback} must be a procedure that takes four arguments: priority of a log message, a function name, the message and a custom user data. Throw @code{guile-ssh-error} on an error. Return value is undefined. Here is an example of a custom callback which indents each log message according to its priority: @lisp (define (pretty-log-printer priority function message userdata) (do ((i 1 (1+ i))) ((> i priority)) (display " " (current-error-port))) (format (current-error-port) "[~a] ~a~%" (strftime "%Y-%m-%dT%H:%M:%S%z" (localtime (current-time))) message)) (set-logging-callback! pretty-log-printer) @end lisp You can restore the default callback as the follows: @lisp (set-logging-callback! %default-log-printer) @end lisp @end deffn @deffn {Scheme Procedure} set-log-userdata! user-data Set an arbitrary @var{user-data} to be passed to a logging callback. Throw @code{guile-ssh-error} on an error. Return value is undefined. By default the user data is set to @code{#f}. @end deffn @deffn {Scheme Procedure} get-log-userdata Get the current user data. @end deffn @deffn {Scheme Procedure} format-log priority procedure-name format-string arg ... Write a formatted message to the libssh log with the given @var{priority}. Return value is undefined. Syntax for the @var{format-string} is the same as for @code{format} procedure. @var{priority} is expected to be a symbol. Acceptable priority levels are: @table @samp @item nolog The message will be printed even if the logging is disabled @item rare Rare and noteworthy events @item protocol High level protocol information @item packet Lower level protocol infomations, packet level @item functions Function path @end table Note that the procedure uses the provided logging callback directly, bypassing the libssh logging facilities. @end deffn @deffn {Scheme Procedure} set-log-verbosity! verbosity Set the global log verbosity to a @var{verbosity}. Throw @code{guile-ssh-error} on error. Return value is undefined. @var{verbosity} is expected to be one of the following symbols: @table @samp @item nolog The message will be printed even if the logging is disabled @item rare Rare and noteworthy events @item protocol High level protocol information @item packet Lower level protocol infomations, packet level @item functions Function path @end table @end deffn @deffn {Scheme Procedure} get-log-verbosity Get global log verbosity value. @end deffn @c Local Variables: @c TeX-master: "guile-ssh.texi" @c End: guile-ssh-0.18.0/doc/api-messages.texi000066400000000000000000000146451471416131000175260ustar00rootroot00000000000000@c -*-texinfo-*- @c This file is part of Guile-SSH Reference Manual. @c Copyright (C) 2014-2021 Artyom V. Poptsov @c See the file guile-ssh.texi for copying conditions. @node Messages @section Messages @cindex talking to a SSH client @tindex message The @code{(ssh message)} module provides procedures for handling of Guile-SSH messages. @menu * Message Handling:: * Parsing of Requests:: @end menu @c ----------------------------------------------------------------------------- @node Message Handling @subsection Messages Handling A message is an object that represents a single request to a Guile-SSH server. Basically the server handles requests in some loop in which it accepts messages with @code{server-message-get} procedure (@pxref{Servers}), handles the received request and replies to the message. @deffn {Scheme Procedure} message? x Return @code{#t} if @var{x} a Guile-SSH message, @code{#f} otherwise. @end deffn @deffn {Scheme Procedure} message-reply-default message Reply with @var{SSH_MSG_UNIMPLEMENTED}. Throw @code{guile-ssh-error} on error. Return value is undefined. @end deffn @deffn {Scheme Procedure} message-reply-success message [args] Reply ``success'' to the @var{message}. This procedure is a convenient wrapper for other @code{*-reply-success} procedures (see below). The right procedure to use will be selected depending on a type of the @code{message}. The procedure may take additional argument @code{'partial} for that changes reply to authentication request, and a @code{bound-port} for a global request. Throw an exception on error. Return value is undefined. @end deffn @deffn {Scheme Procedure} message-service-reply-success message Reply with ``success'' status on the service-request @var{message}. Throw @code{guile-ssh-error} on error. Return value is undefined. @end deffn @deffn {Scheme Procedure} message-auth-reply-success message partial? Reply with ``success'' on the auth-request @var{message}. Throw @code{guile-ssh-error} on error. Return value is undefined. @end deffn @deffn {Scheme Procedure} message-channel-request-reply-success message Reply ``success'' on a channel-request @var{message}. Throw @code{guile-ssh-error} on error. Return value is undefined. @end deffn @deffn {Scheme Procedure} message-global-request-reply-success message bound-port Reply ``success'' on a global request @var{message}. Throw @code{guile-ssh-error} on error. Return value is undefined. @end deffn @deffn {Scheme Procedure} message-auth-reply-public-key-ok message Reply ``OK'' on the public key auth-request @var{message}. Throw @code{guile-ssh-error} on error. Return value is undefined. @end deffn @deffn {Scheme Procedure} message-channel-request-open-reply-accept message Accept open-channel request. Return a new Guile-SSH channel, or @code{#f} on error. @end deffn @deffn {Scheme Procedure} message-get-type message Get type of the @var{message} in the following format: @example = "'(" [ ] ")" @end example The procedure returns @code{#f} on error. Example: @lisp (message-get-type msg) @result{} '(request-auth auth-method-none) @end lisp Possible types: @table @samp @item request-auth Subtypes: @table @samp @item auth-method-unknown @item auth-method-none @item auth-method-password @item auth-method-publickey @item auth-method-hostbased @item auth-method-interactive @end table @item request-channel-open Subtypes: @table @samp @item channel-unknown @item channel-session @item channel-direct-tcpip @item channel-forwarded-tcpip @item channel-x11 @end table @item request-channel Subtypes: @table @samp @item channel-request-unknown @item channel-request-pty @item channel-request-exec @item channel-request-shell @item channel-request-env @item channel-request-subsystem @item channel-request-window-change @end table @item request-service @item request-global Subtypes: @table @samp @item global-request-unknown @item global-request-tcpip-forward @item global-request-cancel-tcpip-forward @end table @end table @end deffn @deffn {Scheme Procedure} message-get-req message Get a request object from the @var{message}. Returns a new request object (@pxref{Parsing of Requests}). Throw @code{guile-ssh-error} on error. @end deffn @deffn {Scheme Procedure} message-auth-set-methods! message methods-list Set authentication methods to @var{methods-list}. Possible methods are: @code{password}, @code{public-key}, @code{interactive}, @code{host-based}. Throw @code{guile-ssh-error} on error. Return value is undefined. @end deffn @deffn {Scheme Procedure} message-get-session message Get the session from which the @var{message} was received. Return the session. @end deffn @c ----------------------------------------------------------------------------- @node Parsing of Requests @subsection Parsing of Requests @cindex handling of requests @tindex request @deffn {Scheme Procedure} service-req:service request Get service name from a service @var{request}. @end deffn @deffn {Scheme Procedure} channel-open-req:orig request @deffnx {Scheme Procedure} channel-open-req:orig-port request @deffnx {Scheme Procedure} channel-open-req:dest request @deffnx {Scheme Procedure} channel-open-req:dest-port request Get originator, originator-port, destination and destination-port from the channel-open @var{request}. @end deffn @deffn {Scheme Procedure} auth-req:user request @deffnx {Scheme Procedure} auth-req:password request @deffnx {Scheme Procedure} auth-req:pubkey request @deffnx {Scheme Procedure} auth-req:pubkey-state request Get user, password, public key and public key state from the auth @var{request}. @end deffn @deffn {Scheme Procedure} pty-req:term request @deffnx {Scheme Procedure} pty-req:width request @deffnx {Scheme Procedure} pty-req:height request @deffnx {Scheme Procedure} pty-req:pxwidth request @deffnx {Scheme Procedure} pty-req:pxheight request Get terminal, terminal width, terminal height, terminal pxwidth and terminal pxheight from the @acronym{PTY} @var{request}. @end deffn @deffn {Scheme Procedure} env-req:name request @deffnx {Scheme Procedure} env-req:value request Get environment variable name and its value from the environment @var{request}. @end deffn @deffn {Scheme Procedure} exec-req:cmd request Get a command from the exec @var{request}. @end deffn @deffn {Scheme Procedure} global-req:addr request @deffnx {Scheme Procedure} global-req:port request Get address and port from the global @var{request}. @end deffn @c Local Variables: @c TeX-master: "guile-ssh.texi" @c End: guile-ssh-0.18.0/doc/api-popen.texi000066400000000000000000000126651471416131000170400ustar00rootroot00000000000000@c -*-texinfo-*- @c This file is part of Guile-SSH Reference Manual. @c Copyright (C) 2015-2024 Artyom V. Poptsov @c See the file guile-ssh.texi for copying conditions. @node Remote Pipes @section Remote Pipes @cindex remote pipes @code{(ssh popen)} provides API for working with remote pipes, akin to @code{(ice-9 popen)} procedures (@pxref{Pipes,,, guile, The GNU Guile Reference Manual}) @var{mode} argument allows to specify what kind of pipe should be created. Allowed values are: @code{OPEN_READ}, @code{OPEN_WRITE}, @code{OPEN_BOTH}. There is an additional value, @code{OPEN_PTY}, that allows to request a @abbr{PTY, Pseudo Terminal}. The terminal is needed to run such commands as @command{top}. Thus, to run @command{top} on the remote side you need to open a remote pipe with ``t'' flag set. @strong{Note} that when a PTY is used, a server merges @code{stderr} and @code{stdout} streams. Values of the aforementioned constants: @table @samp @item OPEN_READ ``r'' @item OPEN_WRITE ``w'' @item OPEN_BOTH ``r+'' @item OPEN_PTY ``t'' @end table @deffn {Scheme Procedure} open-remote-pipe session command mode Execute a @var{command} on the remote host using a @var{session} with a pipe to it. Returns newly created channel port (@xref{Channels} for more info) with the specified @var{mode}. @end deffn @deffn {Scheme Procedure} open-remote-pipe* session mode prog [args...] Execute @var{prog} on the remote host with the given @var{args} using a @var{session} with a pipe to it. Returns newly created channel port with the specified @var{mode}. The behavior is the same as for @code{open-pipe*} (@pxref{Pipes,,, guile, The GNU Guile Reference Manual}) -- the program name and each argument is quoted with single quotes and joined together separated by spaces, then the resulting string is executed on the remote side as a single command. @end deffn @deffn {Scheme Procedure} open-remote-input-pipe session command @deffnx {Scheme Procedure} open-remote-input-pipe* session prog [args...] Equivalent to @code{open-remote-pipe} and @code{open-remote-pipe*} respectively with mode @code{OPEN_READ}. @end deffn @deffn {Scheme Procedure} open-remote-output-pipe session command @deffnx {Scheme Procedure} open-remote-output-pipe* session prog [args...] Equivalent to @code{open-remote-pipe} and @code{open-remote-pipe*} respectively with mode @code{OPEN_WRITE}. @end deffn @c ----------------------------------------------------------------------------- @subsection Examples @subsubsection Simple cases Here's a self-explanatory little script that executes @code{uname -o} command on the local host and prints the result: @lisp #!/usr/bin/env -S guile -L modules -e main -s !# (use-modules (ice-9 rdelim) ; @{read,write@}-line ;; Guile-SSH (ssh session) (ssh auth) (ssh popen)) ; remote pipes (define (main args) ;; Make an SSH session to the local machine and the current user. (let ((session (make-session #:host "localhost"))) ;; Connect the session and perform the authentication. (connect! session) (authenticate-server session) (userauth-agent! session) ;; Execute the command on the remote side and get the input pipe ;; to it. (let ((channel (open-remote-input-pipe* session "uname" "-o"))) ;; Read and display the result. (write-line (read-line channel))))) @end lisp @c ----------------------------------------------------------------------------- @subsubsection Executing a command with a pseudo terminal Surely we aren't limited to one-line outputs; for example, we can watch @code{top} command executing on a remote side locally, by reading data from the channel in a loop: @lisp (define OPEN_PTY_READ (string-append OPEN_PTY OPEN_READ)) (let ((channel (open-remote-pipe* session OPEN_PTY_READ "top" "-u" "avp"))) (let r ((line (read-line channel))) (unless (eof-object? line) (write-line line) (r (read-line channel))))) @end lisp Or we can do the same, but this time with streams: @lisp (use-modules (srfi srfi-41) ; streams (ssh session) (ssh auth) (ssh popen)) (define (pipe->stream p) (stream-let loop ((c (read-char p))) (if (eof-object? c) (begin (close-input-port p) stream-null) (stream-cons c (loop (read-char p)))))) (define OPEN_PTY_READ (string-append OPEN_PTY OPEN_READ)) (define (main args) (let ((s (make-session #:host "example.org"))) (connect! s) (userauth-agent! s) (let ((rs (pipe->stream (open-remote-pipe* s OPEN_PTY_READ "top" "-u" "avp")))) (stream-for-each display rs)))) @end lisp @c ----------------------------------------------------------------------------- @subsubsection Controlling the pseudo terminal size To set the size of a pseudo terminal, one may use @code{channel-set-pty-size!} from @code{(ssh channel)}. For example: @lisp (use-modules (ssh popen) (ssh auth) (ssh channel)) (define OPEN_PTY_READ (string-append OPEN_PTY OPEN_READ)) ;; Opening of a Guile-SSH session goes here ... (let ((p (open-remote-pipe* session OPEN_PTY_READ "top" "-u" "avp"))) (channel-set-pty-size! p 80 50) ;; Reading output from a port ... ) @end lisp @c Local Variables: @c TeX-master: "guile-ssh.texi" @c End: guile-ssh-0.18.0/doc/api-servers.texi000066400000000000000000000102241471416131000173750ustar00rootroot00000000000000@c -*-texinfo-*- @c This file is part of Guile-SSH Reference Manual. @c Copyright (C) 2014 Artyom V. Poptsov @c See the file guile-ssh.texi for copying conditions. @node Servers @section Servers @cindex servers @tindex server The @code{(ssh server)} module provides facilities for creation and managing of Guile-SSH servers. @deffn {Scheme Procedure} server? x Return @code{#t} if @var{x} is a Guile-SSH server, @code{#f} otherwise. @end deffn @deffn {Scheme Procedure} %make-server Make a new Guile-SSH server. @end deffn @deffn {Scheme Procedure} make-server [keywords] Make a new Guile-SSH server with the specified configuration specified by keywords. Return a new Guile-SSH server. Example: @lisp (let ((s (make-server #:bindport 12345 #:rsakey "/home/bob/.ssh/id_rsa" #:log-verbosity 'nolog))) ...) @end lisp @end deffn @deffn {Scheme Procedure} server-set! server option value Set a @var{option} to @var{value} for Guile-SSH @var{server}. Throw @code{guile-ssh-error} on error. Return value is undefined. Here is the description of available options. The description is based on libssh documentation: @table @samp @item bindaddr Set the bind address for the @var{server}. Expected type of @var{value}: string. @item bindport Set the bind port for the @var{server}, default is 22. Expected type of @var{value}: number. @item hostkey Set the @var{server} public key type: ``ssh-rsa'' or ``ssh-dss''. @strong{libssh 0.7 note:} you should pass a path to an ssh key for this option. Only one key from per key type (RSA, DSA, ECDSA) is allowed in an server at a time, and later calls to @code{server-set!} with this option for the same key type will override prior calls. Expected type of @var{value}: string. @item dsakey Set the path to the @acronym{SSH} host @acronym{DSA} key. Expected type of @var{value}: string. @item rsakey Set the path to the @acronym{SSH} host @acronym{RSA} key. Expected type of @var{value}: string. @item banner Set the @var{server} banner sent to clients. Expected type of @var{value}: string. @item log-verbosity Set the logging verbosity. Possible values: @table @samp @item nolog No logging at all @item rare Only rare and noteworthy events @item protocol High level protocol information @item packet Lower level protocol infomations, packet level @item functions Every function path @end table Expected type of @var{value}: symbol. @item blocking-mode Set the @var{server} to blocking/nonblocking mode according to @var{value}. The @var{value} is expected to be @code{#t} or @code{#f}. Expected type of @var{value}: boolean. @end table @end deffn @deffn {Scheme Procedure} server-get server option Get value of @var{option} for Guile-SSH @var{server}. Return @var{option} value, or @code{#f} if the @var{option} does not set. Throw @code{guile-ssh-error} on error. @end deffn @deffn {Scheme Procedure} server-listen server Start listening to the socket. Throw @code{guile-ssh-error} on error. Return value undefined. @end deffn @deffn {Scheme Procedure} server-accept server Accept an incoming @acronym{SSH} connection to the @var{server}. Return a new Guile-SSH session. Throw @code{guile-ssh-error} on error. Example: @lisp (let ((session (catch 'guile-ssh-error (lambda () (server-accept server)) (lambda (key . args) ;; Handle error #f)))) ...) @end lisp One of the possible causes of errors might be that your server has no access to host keys. If you get an exception and it shows no cause of the error then try to set @code{log-verbosity} to a value other than @code{nolog} (e.g. to @code{rare}, see @code{server-set!} above) and check printouts from the libssh. @end deffn @deffn {Scheme Procedure} server-handle-key-exchange session Handle key exchange for a @var{session} and setup encryption. Throw @code{guile-ssh-error} on error. Return value is undefined. @end deffn @deffn {Scheme Procedure} server-message-get session Get a message from a SSH client (@pxref{Messages}). Return a new Guile-SSH message, or @code{#f} on error. @end deffn @c Local Variables: @c TeX-master: "guile-ssh.texi" @c End: guile-ssh-0.18.0/doc/api-sessions.texi000066400000000000000000000363431471416131000175640ustar00rootroot00000000000000@c -*-texinfo-*- @c This file is part of Guile-SSH Reference Manual. @c Copyright (C) 2014-2024 Artyom V. Poptsov @c See the file guile-ssh.texi for copying conditions. @node Sessions @section Sessions @menu * Session Management:: * Callbacks:: @end menu @c ----------------------------------------------------------------------------- @node Session Management @subsection Session Management @cindex sessions @tindex session A session is an object that holds all the information about connection to a specified server or a client. This information includes server's port and address, name of the user, compression level, private keys and so on. A session may contain zero or more channels (@pxref{Channels}). Channels are ``pipes'' that link the client and the server together and that can be used for transferring of data in both directions. So the overall picture can be thought like this: @example [client] [server] \____________________________/ SSH session ============================ ============================ SSH channels ============================ ____________________________ / \ @end example libssh docs say that there is no limit to number of channels for a single session in theory. This chapter describes session management. The code is in the @code{(ssh session)} module. @deffn {Scheme Procedure} session? x Returns @code{#t} if @var{x} is a Guile-SSH session, @code{#f} otherwise. @end deffn @deffn {Scheme Procedure} %make-session Create a new Guile-SSH session. @end deffn @deffn {Scheme Procedure} make-session [keywords] Create a new Guile-SSH session and set its options. Options can be passed as keywords. Return a new Guile-SSH session. This procedure is more convenient than primitive @code{%make-session}, but on other hand it should be a bit slower because of additional checks. Example: @lisp (let ((s (make-session #:user "alice" #:host "example.com" #:port 12345 #:identity "/home/alice/.ssh/id_rsa" #:log-verbosity 'nolog))) ...) @end lisp All options are described in detail in @code{session-set!} procedure description. Options that are read from @var{config} file will be overwritten by the values passed to @code{make-session}. List of allowed keywords: @table @samp @item add-identity @item callbacks @item ciphers-c-s @item ciphers-s-c @item compression @item compression-c-s @item compression-level @item compression-s-c @item config Set the configuration file path. Note that @var{host} must be set to properly load configuration otherwise @code{guile-ssh-error} will be thrown. If this option is set to @code{#t} the default user configuration file @file{~/.ssh/config} is read. On the other hand setting it to @code{#f} value means that no configuration file will be read (@code{process-config?} is set to @code{#f}.) On older versions of libssh (prior to 0.9) setting @code{#:config} to @code{#f} is handled by setting the configuration file to @file{/dev/null} which in turn leads to ignoring the default configuration file. @item host @item identity @item knownhosts @item log-verbosity @item nodelay @item port @item proxycommand @item public-key-accepted-types Preferred public key algorithms to be used for authentication (comma-separated list as a string). Example: ``ssh-rsa,rsa-sha2-256,ssh-dss,ecdh-sha2-nistp256'' This option available only in libssh 0.8.3 or later versions. @item ssh-dir @item ssh1 @item ssh2 @item stricthostkeycheck @item timeout @item timeout-usec @item user @end table @end deffn @deffn {Scheme Procedure} blocking-flush! session timeout Blocking flush of the outgoing buffer of @var{session}. Return on of the following symbols: @table @samp @item ok Success. @item again @var{timeout} occurred. @item error An error occurred. @end table @end deffn @deffn {Scheme Procedure} session-set! session option value Set a @var{option} to @code{value} for the given Guile-SSH @var{session}. Throw a @code{guile-ssh-error} on error. Return value is undefined. Here is the description of available options. The description is based on libssh documentation: @table @samp @item host The hostname or @acronym{IP} address to connect to. Expected type of @var{value}: string. @item port The port to connect to. Expected type of @var{value}: number. @item fd The file descriptor to use. If you wish to open the socket yourself for a reason or another, set the file descriptor. Don't forget to set the hostname as the hostname is used as a key in the known_host mechanism. Expected type of @var{value}: number. @item bindaddr The address to bind the client to. Expected type of @var{value}: string. @item user The username for authentication. Expected type of @var{value}: string. @item ssh-dir Set the SSH directory. The ssh directory is used for files like known_hosts and identity (private and public key). It may include @code{%s} which will be replaced by the user home directory. Expected type of @var{value}: string. @item identity Set the identity file name. In libssh prior version 0.10 @file{id_dsa} and @file{id_rsa} are checked by default. In libssh 0.10 or newer versions @file{id_rsa}, @file{id_ecdsa} and @file{id_ed25519} are checked by default. The identity file used authenticate with public key. It may include @code{%s} which will be replaced by the user home directory. @item knownhosts Set the known hosts file name. Default value is @file{~/.ssh/known_hosts}. The known hosts file is used to certify remote hosts are genuine. The string may include @code{%s} which will be replaced by the user home directory. Expected type of @var{value}: string. @item timeout Set a timeout for the connection in seconds. Expected type of @var{value}: number. @item timeout-usec Set a timeout for the connection in micro seconds. Expected type of @var{value}: number. @item ssh1 Allow or deny the connection to SSH1 servers. Expected type of @var{value}: boolean. @item ssh2 Allow or deny the connection to SSH2 servers Expected type of @var{value}: boolean. @item log-verbosity Set the session logging verbosity. Possible values: @table @samp @item nolog No logging at all @item rare Only rare and noteworthy events @item protocol High level protocol information @item packet Lower level protocol infomations, packet level @item functions Every function path @end table Expected type of @var{value}: symbol. @item ciphers-c-s Set the symmetric cipher client to server. The @var{value} must be a string of comma-separated values. @item ciphers-s-c Set the symmetric cipher server to client. The @var{value} must be a string of comma-separated values. @item compression-c-s Set the compression to use for client to server. The @var{value} must be ``yes'', ``no'' or a specific algorithm name if needed ("zlib", @verb{|"zlib@openssh.com"|}, "none"). Expected type of @var{value}: string. @item compression-s-c Set the compression to use for server to client. The @var{value} must be ``yes'', ``no'' or a specific algorithm name if needed ("zlib", @verb{|"zlib@openssh.com"|}, "none"). Expected type of @var{value}: string. @item process-config? Set it to @code{#f} to disable automatic processing of per-user and system-wide OpenSSH configuration files. LibSSH automatically uses these configuration files unless you provide it with this option or with different file. Compatibility: this option was added in libssh 0.9.0. Expected type of @var{value}: boolean. @item proxycommand Set the command to be executed in order to connect to server. Expected type of @var{value}: string. @item rsa-min-size Set the minimum RSA key size in bits to be accepted by the client for both authentication and hostkey verification. The values under 768 bits are not accepted even with this configuration option as they are considered completely broken. Setting 0 will revert the value to defaults. Default is 1024 bits or 2048 bits in FIPS mode. Expected type of @var{value}: number. @item stricthostkeycheck Set the parameter @code{StrictHostKeyChecking} to avoid asking about a fingerprint. @item compression Set the compression to use for both directions communication. The @var{value} must be ``yes'', ``no'' or a specific algorithm name if needed ("zlib", @verb{|"zlib@openssh.com"|}, "none"). Expected type of @var{value}: string. @item compression-level Set the compression level to use for zlib functions. The @var{value} is expected to be a number from 1 to 9, 9 being the most efficient but slower. @item callbacks Set callbacks that will be called on related events (@pxref{Callbacks}.) Expected type of @var{value}: an association list (alist). @item config The option specifies whether an SSH config should be parsed or not, and optionally the path to a config file. Setting the @var{value} to @code{#t} (the default value) means that the default @file{~/.ssh/config} should be parsed; in turn, setting the option to @code{#f} means that the config should not be parsed at all. If the value is a string, then the string is expected to be a path to config file. The procedure reads the config file after all other specified options are set. When the config file is read, the options for @var{session} are set, overwriting those that were passed to the procedure. You @emph{must} specify at least a host name when using this option, otherwise the procedure will fail. Optionally you could use @code{session-parse-config!} procedure explicitly to read the config (see below.) Expected types of @var{value}: Either a string or a boolean value. @end table @end deffn @deffn {Scheme Procedure} session-parse-config! session [file-name] Parse an SSH config @var{file-name} and set @var{session} options. If @var{file-name} is not set, the default SSH @file{~/.ssh/config} is used. Throw @code{guile-ssh-error} on an error. Return value is undefined. @end deffn @deffn {Scheme Procedure} session-get session option Get value of the @var{option} for @var{session}. The @var{option} is expected to be a symbol. Please not that currently not all the possible session options can be gotten with this procedure. Here is the list of allowed options: @table @samp @item host @item port @item user @item identity @item proxycommand @item callbacks @end table @end deffn @deffn {Scheme Procedure} connect! session Connect @var{session} to a SSH server. Return one of the following symbols: @code{ok}, @code{again}, @code{error}. @end deffn @deffn {Scheme Procedure} disconnect! session Disconnect the @var{session}. This procedure can be used by a client as well as by a server. @end deffn @deffn {Scheme Procedure} authenticate-server session Authenticate the server. Throw @code{wrong-type-arg} exception if a disconnected @var{session} is passed as an argument. Return one of the following symbols: @table @samp @item ok The server is known and has not changed. @item known-changed The server key has changed. Either you are under attack or the administrator changed the key. You @emph{have} to warn the user about a possible attack. @item found-other The server gave use a key of a type while we had an other type recorded. It is a possible attack. @item not-known The server is unknown. User should confirm the MD5 is correct. @item file-not-found The known host file does not exist. The host is thus unknown. File will be created if host key is accepted. @item error An error occurred. @end table @end deffn @deffn {Scheme Procedure} get-server-public-key session Get server public key from a @var{session}. Return the server's public key. Throw @code{guile-ssh-error} on error. Also throw @code{wrong-type-arg} exception if a disconnected @var{session} is passed as an argument. See also @code{get-public-key-hash} in @pxref{Keys}. @end deffn @deffn {Scheme Procedure} write-known-host! session Write the current server as known in the known hosts file. Throw @code{guile-ssh-error} on error. Throw @code{wrong-type-arg} exception if a disconnected session is passed as an argument. Return value is undefined. @end deffn @deffn {Scheme Procedure} connected? session Check if we are connected. Return @code{#f} if we are connected to a server, @code{#f} if we aren't. @end deffn @deffn {Scheme Procedure} get-error session @cindex handling session errors Retrieve the error text message from the last error related to @var{session}. @end deffn @deffn {Scheme Procedure} get-protocol-version session Get version of SSH protocol. Return 1 for SSH1, 2 for SSH2 or @code{#f} on error. Throw @code{wrong-type-arg} exception if a disconnected @var{session} is passed as an argument. @end deffn @c ----------------------------------------------------------------------------- @node Callbacks @subsection Callbacks Guile-SSH uses an association list (@pxref{Association Lists,,, guile, The GNU Guile Reference Manual}) to represent session callbacks; the key is a callback name, and the value is expecting to be a procedure. Session callbacks is the way to handle some events, notably the incoming reverse port forwarding requests on the server side. Each callback is called with the optional @code{user-data} argument which can be specified in the callbacks alist as well. @deffn {Scheme Procedure} global-request-callback session message user-data A server-side callback that is called on a global request (e.g. when an SSH client asks for reverse port forwarding.) The callback should be set on an accepted Guile-SSH session (@pxref{Servers}) in case when global requests must be handled; note that if the callback is not set then the server will always deny global requests, which may be confusing. Example: @lisp (define (handle-global-request session message user-data) (let ((port-number 12345)) (message-reply-success message port-number))) ;; Let's suppose that the session was created earlier. ;; Now we can set our callback: (session-set! session 'callbacks `((user-data . #f) (global-request-callback . ,handle-global-request))) ;; Note that 'user-data' is optional, so the following example ;; is valid: (session-set! session 'callbacks `((global-request-callback . ,handle-global-request))) @end lisp @end deffn @deffn {Scheme Procedure} connect-status-callback session status user-data This callback is called during connection establishment process (that is, after @code{connect!} is called) with a server. A connection @var{status} is a number that shows what percentage of connection esablishment is done. Example: @lisp (define (print-status session status user-data) (let ((percentage (truncate (* status 100)))) (format #t "~a: connecting ... ~a%~%" session percentage))) ;; Let's suppose that the session was created earlier. (session-set! session 'callbacks `((user-data . #f) (connect-status-callback . ,print-status))) ;; Or we can set two callbacks simultaneously: (define (handle-global-request session message user-data) (let ((port-number 12345)) (message-reply-success message port-number))) (session-set! session 'callbacks `((user-data . #f) (connect-status-callback . ,print-status) (global-request-callback . ,handle-global-request))) @end lisp @end deffn @c Local Variables: @c TeX-master: "guile-ssh.texi" @c End: guile-ssh-0.18.0/doc/api-sftp.texi000066400000000000000000000242171471416131000166670ustar00rootroot00000000000000@c -*-texinfo-*- @c This file is part of Guile-SSH Reference Manual. @c Copyright (C) 2015-2022 Artyom V. Poptsov @c See the file guile-ssh.texi for copying conditions. @node SFTP @section SFTP @cindex SFTP @cindex file transfer The @code{(ssh sftp)} module provides procedures for working with @abbr{SFTP, Secure File Transfer Protocol}. @c ----------------------------------------------------------------------------- @subsection SFTP Session @deffn {Scheme Procedure} make-sftp-session ssh-session Make a new SFTP session using a @var{ssh-session}, initialize the session with a server. Return initialized SFTP session or throw @code{guile-ssh-error} exception on an error. @end deffn @deffn {Scheme Procedure} sftp-session? x Return @code{#t} if @var{x} is a SFTP session, @code{#f} otherwise. @end deffn @deffn {Scheme Procedure} sftp-get-session sftp-session Get the parent SSH session for a @var{sftp-session}. @end deffn @deffn {Scheme Procedure} sftp-get-error sftp-session Get the last SFTP error from a @var{sftp-session}. Return the error name as a symbol, or throw @code{guile-ssh-error} on if an error occurred in the procedure itself. The procedure returns one of the following values: @table @samp @item fx-ok No error. @item fx-eof End-of-file encountered. @item fx-no-such-file File doesn't exist. @item fx-permission-denied Permission denied. @item fx-failure Generic failure. @item fx-bad-message Garbage received from the server. @item fx-no-connection No connection has been set up. @item fx-connection-lost There was a connection, but we lost it. @item fx-op-unsupported Operation not supported by the server. @item fx-invalid-handle Invalid file handle. @item fx-no-such-path No such file or directory path exists. @item fx-file-already-exist An attempt to create an already existing file or directory has been made. @item fx-write-protect We are trying to write on a write-protected filesystem. @item fx-no-media No media in remote drive. @end table @end deffn @deffn {Scheme Procedure} sftp-mkdir sftp-session dirname [mode=#o777] Create a directory @var{dirname} using a @var{sftp-session} with a @var{mode}. If the @var{mode} is omitted, the current umask value is used. @end deffn @deffn {Scheme Procedure} sftp-rmdir sftp-session dirname Remove a directory @var{dirname}. Throw @code{guile-ssh-error} on an error. Return value is undefined. @end deffn @deffn {Scheme Procedure} sftp-mv sftp-session source dest Move or rename a file @var{source} into a @var{dest}. Throw @code{guile-ssh-error} on an error. Return value is undefined. @end deffn @deffn {Scheme Procedure} sftp-symlink sftp-session target dest Create a symbolic link to a @var{target} in a @var{dest}. Throw @code{guile-ssh-error} on an error. Return value is undefined. @end deffn @deffn {Scheme Procedure} sftp-readlink sftp-session path Read the value of a symbolic link pointed by a @var{path}. Return the value or @code{#f} on an error. @end deffn @deffn {Scheme Procedure} sftp-chmod sftp-session filename mode Change permissions of a remote @var{filename} using @var{sftp-session}. Permissions are set to @code{mode & ~umask}. Throw @code{guile-ssh-error} on an error. Return value is undefined. @end deffn @deffn {Scheme Procedure} sftp-unlink sftp-session filename Unlink (delete) a remote @var{filename} using @var{sftp-session}. Throw @code{guile-ssh-error} on an error. Return value is undefined. @end deffn @c ----------------------------------------------------------------------------- @subsubsection Low-Level API @deffn {Scheme Procedure} %make-sftp-session ssh-session Make a new SFTP session using a @var{ssh-session} without initialization of the session with a server. Throw @code{guile-ssh-error} exception on an error. Note that you should call @code{%sftp-init} on the returned SFTP session before using it. @end deffn @deffn {Scheme Procedure} %sftp-init sftp-session Initialize a @var{sftp-session} with the server. Throw @code{guile-ssh-error} exception on an error, return value is undefined. @end deffn @c ----------------------------------------------------------------------------- @subsection SFTP File Remote files are represented as regular Guile ports that allow random access (@pxref{Input and Output,,, guile, The GNU Guile Reference Manual}.) @deffn {Scheme Procedure} sftp-open sftp-session filename flags [mode=#o666] Open a remote @var{filename} using an @var{sftp-session}, return an open file port. Throw @code{guile-ssh-error} on an error. @end deffn @deffn {Scheme Procedure} sftp-file? x Return @code{#t} if @var{x} is an SFTP file port, @code{#f} otherwise. @end deffn @c ----------------------------------------------------------------------------- @subsection SFTP Directory @cindex directory traversal Those procedures allow to read directory contents on the remote side. @deffn {Scheme Procedure} sftp-dir? x Check if an @var{x} is an SFTP directory instance. Return @code{#t} if it is, @code{#f} otherwise. @end deffn @deffn {Scheme Procedure} sftp-dir-open sftp-session path Open a remote directory with the specified @var{path} using @var{sftp-session}. Return an SFTP directory as opaque object. @end deffn @deffn {Scheme Procedure} sftp-dir-open-stream sftp-session path Open a remote directory with the specified @var{path} using @var{sftp-session}. Return an ice-9 stream of SFTP file attributes. Usage example: @lisp (use-modules (ice-9 streams) (ice-9 pretty-print) (ssh session) (ssh auth) (ssh sftp)) (define (main args) (let ((session (make-session #:host "example.org" #:user "avp"))) (connect! session) (userauth-agent! session) (let* ((sftp-session (make-sftp-session session)) (stream (sftp-dir-open-stream sftp-session "/tmp/"))) (stream-for-each (lambda (attrs) (pretty-print attrs)) stream)))) @end lisp @end deffn @deffn {Scheme Procedure} sftp-dir-path sftp-directory Get the path associated with an @var{sftp-directory}. @end deffn @deffn {Scheme Procedure} sftp-dir-session sftp-directory Get the parent SFTP session for an @var{sftp-directory}. @end deffn @deffn {Scheme Procedure} sftp-dir-close sftp-directory Close an @var{sftp-directory}. Return value is undefined. @end deffn @deffn {Scheme Procedure} sftp-dir-eof? sftp-directory CHeck if an @var{sftp-directory} pointed to an EOF object. @end deffn @deffn {Scheme Procedure} sftp-dir-read sftp-directory Read an @var{sftp-directory}. Return an alist with the next directory attributes. @end deffn @c ----------------------------------------------------------------------------- @subsection High-level operations on remote files @deffn {Scheme Procedure} call-with-remote-input-file sftp-session filename proc Call a @var{proc} with a remote file port opened for input using an @var{sftp-session}. @var{proc} should be a procedure of one argument, @var{filename} should be a string naming a file. The behaviour is unspecified if a file already exists. The procedure calls @var{proc} with one argument: the port obtained by opening the named remote file for input. If the procedure returns, then the port is closed automatically and the values yielded by the procedure are returned. If the procedure does not return, then the port will not be closed automatically unless it is possible to prove that the port will never again be used for a read or write operation. @end deffn @deffn {Scheme Procedure} call-with-remote-output-file sftp-session filename proc Call a @var{proc} with a remote file port opened for output using an @var{sftp-session}. @var{proc} should be a procedure of one argument, @var{filename} should be a string naming a file. The behaviour is unspecified if a file already exists. The procedure calls @var{proc} with one argument: the port obtained by opening the named remote file for output. If the procedure returns, then the port is closed automatically and the values yielded by the procedure are returned. If the procedure does not return, then the port will not be closed automatically unless it is possible to prove that the port will never again be used for a read or write operation. @end deffn @deffn {Scheme Procedure} with-input-from-remote-file sftp-session filename thunk @var{thunk} must be a procedure of no arguments, and @var{filename} must be a string naming a file. The file must already exist. The file is opened for input, an input port connected to it is made the default value returned by @code{current-input-port}, and the @var{thunk} is called with no arguments. When the @var{thunk} returns, the port is closed and the previous default is restored. Returns the values yielded by @var{thunk}. If an escape procedure is used to escape from the continuation of these procedures, their behavior is implementation dependent. Example: @lisp (define (rcat user host filename) "Print contents of a remote file on a HOST pointed by a FILENAME to stdout." (let ((session (make-session #:user user #:host host))) ;; Connect to an SSH server. (connect! session) (authenticate-server session) ;; Authenticate with an SSH server using a SSH agent. (userauth-agent! session) (let ((sftp-session (make-sftp-session session))) ;; Read read a file line-by-line and print it to stdout. (with-input-from-remote-file sftp-session filename (lambda () (do ((line (read-line) (read-line))) ((eof-object? line)) (write-line line))))))) @end lisp @end deffn @deffn {Scheme Procedure} with-output-to-remote-file sftp-session filename thunk @var{thunk} must be a procedure of no arguments, and @var{filename} must be a string naming a file. The effect is unspecified if the file already exists. The file is opened for output, an output port connected to it is made the default value returned by @code{current-output-port}, and the @var{thunk} is called with no arguments. When the @var{thunk} returns, the port is closed and the previous default is restored. Returns the values yielded by @var{thunk}. If an escape procedure is used to escape from the continuation of these procedures, their behavior is implementation dependent. @end deffn @c Local Variables: @c TeX-master: "guile-ssh.texi" @c End: guile-ssh-0.18.0/doc/api-shell.texi000066400000000000000000000057201471416131000170200ustar00rootroot00000000000000@c -*-texinfo-*- @c This file is part of Guile-SSH Reference Manual. @c Copyright (C) 2017 Artyom V. Poptsov @c See the file guile-ssh.texi for copying conditions. @node Shell @section Shell @cindex secure shell A high-level interface to a remote shell built upon @code{(ssh popen)} API. The procedures described in this section uses GNU Coreutils on the remote side and may depend on some other packages; see the notes for each procedure. @deffn {Scheme Procedure} rexec session command Execute a @var{command} on the remote side. Return two values: list of output lines returned by a @var{command} and its exit code. @end deffn @deffn {Scheme Procedure} which session program-name Check if a @var{program-name} is available on a remote side. Return two values: a path to a command if it is found and a return code. The procedure uses shell build-in command @command{which} on the remote side. Example: @lisp (use-modules (ssh session) (ssh auth) (ssh shell)) (let ((s (make-session #:host "example.org"))) (connect! s) (userauth-agent! s) (which s "guile")) @result{} ("/usr/bin/guile") @result{} 0 @end lisp @end deffn @deffn {Scheme Procedure} command-available? session command Check if a @var{command} is available on a remote machine represented by a @var{session}. @end deffn @deffn {Scheme Procedure} pgrep session pattern @ [#:full?=#f] @ [#:use-guile?=#f] Search for a process with a @var{pattern} cmdline on a machine represented by a @var{session}. Return two values: a list of PIDs and a return code. The procedure uses a @command{pgrep} from procps package on the remote side when @var{use-guile?} is set to @code{#f} (this is by default.) When @var{use-guile?} is set to @code{#t}, the procedure will execute a Scheme code using GNU Guile on the remote side to kill processes. @end deffn @deffn {Scheme Procedure} pkill session pattern @ [#:full?=#f] @ [#:signal=SIGTERM] @ [#:use-guile?=#f] Send a @var{signal} to a process which name matches to @var{pattern} on a remote machine represented by a @var{session}. Return two values: a list of PIDs of killed processes and a return code. The @var{signal} must be a numeric value as for Guile @code{kill} procedure. The procedure uses a @command{pkill} from procps package on the remote side when @var{use-guile?} is set to @code{#f} (this is by default.) When @var{use-guile?} is set to @code{#t}, the procedure will execute a Scheme code using GNU Guile on the remote side to kill processes. @end deffn @deffn {Scheme Procedure} loadavg session Get average load of a host using a @var{session}. Return a list of five elements as described in proc(5) man page. Example: @lisp (use-modules (ssh session) (ssh auth) (ssh shell)) (let ((s (make-session #:host "example.org"))) (connect! s) (userauth-agent! s) (loadavg s)) @result{} ("0.01" "0.05" "0.10" "4/1927" "242011") @end lisp @end deffn guile-ssh-0.18.0/doc/api-tunnels.texi000066400000000000000000000132161471416131000174000ustar00rootroot00000000000000@c -*-texinfo-*- @c This file is part of Guile-SSH Reference Manual. @c Copyright (C) 2015-2021 Artyom V. Poptsov @c See the file guile-ssh.texi for copying conditions. @node Tunnels @section Tunnels @cindex Tunnels The following procedures from @code{(ssh tunnel)} module are a high-level API built upon the basic port forwarding facilities for managing port forwards. @deffn {Scheme Procedure} make-tunnel session [#:bind-address=''127.0.0.1''] #:port #:host [#:host-port=port] [#:reverse?=#f] Make a new SSH tunnel using @var{session} from @var{bind-address} and @var{port} to a @var{host} and @var{host-port}. The procedure is capable of creating both direct and reverse port forwarding tunnels; the type of a tunnel is determined by @var{reverse?} argument. If @var{reverse?} is set to @code{#f} then a reverse port forwarding tunnel will be created. Setting @var{reverse?} to @code{#t} changes the direction of the tunnel and a reverse port forwarding tunnel will be created. In this case a server allocates a socket to listen to @var{port} on the remote side, and whenever a connection is made to this port, the connection is forwarded over the secure channel, and a connection is made to @var{host} and @var{host-port} from the local machine. @var{host} can be set to @code{#f} to tell the server to listen on all addresses and known protocol families. Setting a @var{port} to 0 tells the server to bind the first unprivileged port. The procedure does not binds ports nor transfers data to the port (in case of reverse port forwarding), you should start port forwarding by means of the procedures that operate on a object -- e.g. @code{start-forward} or @code{call-with-ssh-forward}. Return a new tunnel object. @end deffn @deffn {Scheme Procedure} tunnel? x Return @code{#t} if @var{x} is an Guile-SSH tunnel, @code{#f} otherwise. @end deffn @deffn {Scheme procedure} tunnel-reverse? x Check if @var{x} is a reverse port forwarding tunnel. @end deffn @deffn {Scheme procedure} tunnel-session tunnel Get a session associated with a @var{tunnel}. @end deffn @deffn {Scheme Procedure} tunnel-bind-address tunnel Get a source host of a @var{tunnel}. @end deffn @deffn {Scheme Procedure} tunnel-port tunnel Get a local port of a @var{tunnel}. @end deffn @deffn {Scheme Procedure} tunnel-host tunnel Get a remote host of a @var{tunnel}. @end deffn @deffn {Scheme Procedure} tunnel-host-port tunnel Get a remote port of a @var{tunnel}. @end deffn @deffn {Scheme Procedure} start-forward tunnel Start port forwarding on @var{tunnel}. The procedure actually binds tunnel ports and forwards data. @end deffn @deffn {Scheme Procedure} call-with-ssh-forward tunnel proc Open a new @var{tunnel} and start port forwarding. @var{proc} is called with an open channel as an argument. All I/O on the channel will be forwarded to the remote host and port of a @var{tunnel}. Return the result the @var{proc} call. As a practical example, let's say you want to use @url{https://www.gnu.org/software/guile-rpc/, Guile-RPC} over SSH. Here's how you can implement a using @code{call-with-ssh-forward}: @lisp (let ((pid (primitive-fork))) (if (zero? pid) ;; Make a new SSH session, connect it and authenticate the user. (let* ((host "example.org") (user "alice") (session (make-session #:user user #:host host #:port 22 #:log-verbosity 'nolog))) (connect! session) (userauth-agent! session) ;; Make a new SSH tunnel. (let ((tunnel (make-tunnel session #:port 12345 ;; Guile-RPC server listens on 127.0.0.1 ;; on the remote host. #:host "127.0.0.1" ;; Guile-RPC server port. #:host-port 6666))) ;; Start the forwarder loop. (start-forward tunnel))) ;; Parent process. (let ((sock (socket PF_INET SOCK_STREAM 0))) (dynamic-wind (const #t) (lambda () (sleep 1) ;; Connect to the port that is listened to by the spawned process. (connect sock AF_INET (inet-pton AF_INET "127.0.0.1") 12345) ;; Make an RPC call using the SSH tunnel. (display (invoke-split-number 3.14 #x7777 sock)) (newline)) (lambda () (close sock) (kill pid SIGTERM) (waitpid pid)))))) @end lisp The full example of an RPC client that uses a SSH tunnel is in @file{$prefix/share/guile-ssh/examples/rpc} directory. @end deffn @c ----------------------------------------------------------------------------- @subsection Example Here is a simple Guile program that connects to ``www.example.org'' and starts port forwading from the local port 8080 to the port 80 on the remote host: @lisp #!/usr/bin/guile \ -e main !# (use-modules (ssh session) (ssh auth) (ssh key) (ssh tunnel)) (define (main args) (let ((s (make-session #:user "alice" #:host "localhost" #:port 22 #:log-verbosity 'nolog)) (k (private-key-from-file "/home/alice/.ssh/id_rsa"))) (connect! s) (userauth-public-key! s k) (let ((t (make-tunnel s #:port 8080 #:host "www.example.org" #:host-port 80))) (start-forward t)))) @end lisp @c Local Variables: @c TeX-master: "guile-ssh.texi" @c End: guile-ssh-0.18.0/doc/api-version.texi000066400000000000000000000024661471416131000174020ustar00rootroot00000000000000@c -*-texinfo-*- @c This file is part of Guile-SSH Reference Manual. @c Copyright (C) 2014-2022 Artyom V. Poptsov @c See the file guile-ssh.texi for copying conditions. @node Version @section Version @cindex versions The @code{(ssh version)} module provides functions that is used for getting information about current versions. @deffn {Scheme Procedure} get-libssh-version Get version of the libssh. Returns libssh version as a string in the follwing format: @example ::= "." "." @end example For example, @samp{0.5.2}. @end deffn @deffn {Scheme Procedure} %get-libssh-version Low-level procedure that returns a version string in libssh format, eg. "0.6.3/openssl/zlib". @end deffn @deffn {Scheme Procedure} get-crypto-library Get cryptographic library name with which libssh was compiled. Possible values are: @code{'openssl}, @code{'gnutls}. @end deffn @deffn {Scheme Procedure} zlib-support? Return @code{#t} if libssh was compiled wit zlib support, @code{#f} otherwise. @end deffn @deffn {Scheme Procedure} dsa-support? Return @code{#t} if Guile-SSH was compiled with DSA public key algorithm support, @code{#f} otherwise. @end deffn @deffn {Scheme Procedure} get-library-version Get version of the Guile-SSH. @end deffn @c Local Variables: @c TeX-master: "guile-ssh.texi" @c End: guile-ssh-0.18.0/doc/examples.texi000066400000000000000000000110121471416131000167470ustar00rootroot00000000000000@c -*-texinfo-*- @c This file is part of Guile-SSH Reference Manual. @c Copyright (C) 2014-2021 Artyom V. Poptsov @c See the file guile-ssh.texi for copying conditions. @node Examples @chapter Examples There are working examples that come with Guile-SSH. These examples are normally installed in @file{$prefix/share/guile-ssh/examples} directory: @table @samp @item sssh.scm @itemx ssshd.scm Guile-SSH client and server example. @item echo/client.scm @itemx echo/server.scm Echo client and server example. @end table In addition, the following sections will provide an overview of programming with Guile-SSH. @c ----------------------------------------------------------------------------- @section Client In this example we will connect to a server, open a channel and execute a command. Then we will read output from the command and close connection to the server. @lisp (use-modules (ssh channel) (ssh session) (ssh auth) (ssh key)) (let ((session (make-session #:user "bob" #:host "example.com" #:port 22 #:log-verbosity 'nolog))) ; Be quiet ;; Connect to the server (connect! session) ;; Perform server authentication (case (authenticate-server session) ...) ; Check the result ;; Try to authenticate on the server with one of the `userauth-*' ;; procedures. Let's use `userauth-agent!'. (case (userauth-agent! session) ...) ; Check the result ;; Suppose the authentication went successfully. ;; Now we need to open a channel. (let ((channel (make-channel session))) (if (not channel) ...) ; Handle an error ;; Open a session so we will be able to execute a command ;; on the server (catch 'guile-ssh-error (lambda () (channel-open-session channel)) (lambda (key . args) ...)) ; Handle an error ;; Execute a command (channel-request-exec channel "uname") ;; Check the exit status of the command (or (zero? (channel-get-exit-status channel)) ...) ; Handle error ;; Poll the channel for data (let poll ((ready? #f)) (if ready? (begin ...) ; Read the output from the command (poll (char-ready? channel)))) ;; Close the channel (close channel) ;; Disconnect from the server (disconnect! session))) @end lisp @c ----------------------------------------------------------------------------- @section Server In this example we will create a new server and start the server loop. @lisp (use-modules (ssh server) (ssh message) (ssh session) (ssh channel) (ssh key) (ssh auth)) (let ((server (make-server #:bindport 22 #:rsakey "/home/alice/.ssh/host_rsa_key" #:dsakey "/home/alice/.ssh/host_dsa_key" #:log-verbosity 'nolog))) ; Be quiet ;; Start listen to incoming connections. (server-listen server) ;; Start the main loop of the server (while #t ;; Accept new connections from clients. Every connection is ;; handled in its own SSH session. (let ((session (catch 'guile-ssh-error (lambda () (server-accept server)) (lambda (key . args) ;; Handle an error #f)))) (if (not session) (begin (sleep 1) (continue))) ;; Handle server authentication request from a client (server-handle-key-exchange session) ;; Start the session loop. Handle incoming messages from ;; the client (let session-loop ((msg (server-message-get session))) (if (not msg) ...) ; Handle an error ;; Get type of the received message (let ((msg-type (message-get-type msg))) ;; Handle the message according to the type. Type is a list of ;; symbols where the car is the type and cadr is subtype. (case (car msg-type) ((request-service) ...) ; Handle service request ((request-auth) ...) ; Handle authentication request ((request-channel-open) ...) ; Handle request ((request-channel) ...))) ; Handle request (if (connected? session) (session-loop (server-message-get session)))) (disconnect! session)))) @end lisp @c Local Variables: @c TeX-master: "guile-ssh.texi" @c End: guile-ssh-0.18.0/doc/fdl.texi000066400000000000000000000560151471416131000157120ustar00rootroot00000000000000@c The GNU Free Documentation License. @center Version 1.3, 3 November 2008 @c This file is intended to be included within another document, @c hence no sectioning command or @node. @display Copyright @copyright{} 2000, 2001, 2002, 2007, 2008 Free Software Foundation, Inc. @uref{http://fsf.org/} Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. @end display @enumerate 0 @item PREAMBLE The purpose of this License is to make a manual, textbook, or other functional and useful document @dfn{free} in the sense of freedom: to assure everyone the effective freedom to copy and redistribute it, with or without modifying it, either commercially or noncommercially. Secondarily, this License preserves for the author and publisher a way to get credit for their work, while not being considered responsible for modifications made by others. This License is a kind of ``copyleft'', which means that derivative works of the document must themselves be free in the same sense. It complements the GNU General Public License, which is a copyleft license designed for free software. We have designed this License in order to use it for manuals for free software, because free software needs free documentation: a free program should come with manuals providing the same freedoms that the software does. But this License is not limited to software manuals; it can be used for any textual work, regardless of subject matter or whether it is published as a printed book. We recommend this License principally for works whose purpose is instruction or reference. @item APPLICABILITY AND DEFINITIONS This License applies to any manual or other work, in any medium, that contains a notice placed by the copyright holder saying it can be distributed under the terms of this License. Such a notice grants a world-wide, royalty-free license, unlimited in duration, to use that work under the conditions stated herein. The ``Document'', below, refers to any such manual or work. Any member of the public is a licensee, and is addressed as ``you''. You accept the license if you copy, modify or distribute the work in a way requiring permission under copyright law. A ``Modified Version'' of the Document means any work containing the Document or a portion of it, either copied verbatim, or with modifications and/or translated into another language. A ``Secondary Section'' is a named appendix or a front-matter section of the Document that deals exclusively with the relationship of the publishers or authors of the Document to the Document's overall subject (or to related matters) and contains nothing that could fall directly within that overall subject. (Thus, if the Document is in part a textbook of mathematics, a Secondary Section may not explain any mathematics.) The relationship could be a matter of historical connection with the subject or with related matters, or of legal, commercial, philosophical, ethical or political position regarding them. The ``Invariant Sections'' are certain Secondary Sections whose titles are designated, as being those of Invariant Sections, in the notice that says that the Document is released under this License. If a section does not fit the above definition of Secondary then it is not allowed to be designated as Invariant. The Document may contain zero Invariant Sections. If the Document does not identify any Invariant Sections then there are none. The ``Cover Texts'' are certain short passages of text that are listed, as Front-Cover Texts or Back-Cover Texts, in the notice that says that the Document is released under this License. A Front-Cover Text may be at most 5 words, and a Back-Cover Text may be at most 25 words. A ``Transparent'' copy of the Document means a machine-readable copy, represented in a format whose specification is available to the general public, that is suitable for revising the document straightforwardly with generic text editors or (for images composed of pixels) generic paint programs or (for drawings) some widely available drawing editor, and that is suitable for input to text formatters or for automatic translation to a variety of formats suitable for input to text formatters. A copy made in an otherwise Transparent file format whose markup, or absence of markup, has been arranged to thwart or discourage subsequent modification by readers is not Transparent. An image format is not Transparent if used for any substantial amount of text. A copy that is not ``Transparent'' is called ``Opaque''. Examples of suitable formats for Transparent copies include plain @sc{ascii} without markup, Texinfo input format, La@TeX{} input format, @acronym{SGML} or @acronym{XML} using a publicly available @acronym{DTD}, and standard-conforming simple @acronym{HTML}, PostScript or @acronym{PDF} designed for human modification. Examples of transparent image formats include @acronym{PNG}, @acronym{XCF} and @acronym{JPG}. Opaque formats include proprietary formats that can be read and edited only by proprietary word processors, @acronym{SGML} or @acronym{XML} for which the @acronym{DTD} and/or processing tools are not generally available, and the machine-generated @acronym{HTML}, PostScript or @acronym{PDF} produced by some word processors for output purposes only. The ``Title Page'' means, for a printed book, the title page itself, plus such following pages as are needed to hold, legibly, the material this License requires to appear in the title page. For works in formats which do not have any title page as such, ``Title Page'' means the text near the most prominent appearance of the work's title, preceding the beginning of the body of the text. The ``publisher'' means any person or entity that distributes copies of the Document to the public. A section ``Entitled XYZ'' means a named subunit of the Document whose title either is precisely XYZ or contains XYZ in parentheses following text that translates XYZ in another language. (Here XYZ stands for a specific section name mentioned below, such as ``Acknowledgements'', ``Dedications'', ``Endorsements'', or ``History''.) To ``Preserve the Title'' of such a section when you modify the Document means that it remains a section ``Entitled XYZ'' according to this definition. The Document may include Warranty Disclaimers next to the notice which states that this License applies to the Document. These Warranty Disclaimers are considered to be included by reference in this License, but only as regards disclaiming warranties: any other implication that these Warranty Disclaimers may have is void and has no effect on the meaning of this License. @item VERBATIM COPYING You may copy and distribute the Document in any medium, either commercially or noncommercially, provided that this License, the copyright notices, and the license notice saying this License applies to the Document are reproduced in all copies, and that you add no other conditions whatsoever to those of this License. You may not use technical measures to obstruct or control the reading or further copying of the copies you make or distribute. However, you may accept compensation in exchange for copies. If you distribute a large enough number of copies you must also follow the conditions in section 3. You may also lend copies, under the same conditions stated above, and you may publicly display copies. @item COPYING IN QUANTITY If you publish printed copies (or copies in media that commonly have printed covers) of the Document, numbering more than 100, and the Document's license notice requires Cover Texts, you must enclose the copies in covers that carry, clearly and legibly, all these Cover Texts: Front-Cover Texts on the front cover, and Back-Cover Texts on the back cover. Both covers must also clearly and legibly identify you as the publisher of these copies. The front cover must present the full title with all words of the title equally prominent and visible. You may add other material on the covers in addition. Copying with changes limited to the covers, as long as they preserve the title of the Document and satisfy these conditions, can be treated as verbatim copying in other respects. If the required texts for either cover are too voluminous to fit legibly, you should put the first ones listed (as many as fit reasonably) on the actual cover, and continue the rest onto adjacent pages. If you publish or distribute Opaque copies of the Document numbering more than 100, you must either include a machine-readable Transparent copy along with each Opaque copy, or state in or with each Opaque copy a computer-network location from which the general network-using public has access to download using public-standard network protocols a complete Transparent copy of the Document, free of added material. If you use the latter option, you must take reasonably prudent steps, when you begin distribution of Opaque copies in quantity, to ensure that this Transparent copy will remain thus accessible at the stated location until at least one year after the last time you distribute an Opaque copy (directly or through your agents or retailers) of that edition to the public. It is requested, but not required, that you contact the authors of the Document well before redistributing any large number of copies, to give them a chance to provide you with an updated version of the Document. @item MODIFICATIONS You may copy and distribute a Modified Version of the Document under the conditions of sections 2 and 3 above, provided that you release the Modified Version under precisely this License, with the Modified Version filling the role of the Document, thus licensing distribution and modification of the Modified Version to whoever possesses a copy of it. In addition, you must do these things in the Modified Version: @enumerate A @item Use in the Title Page (and on the covers, if any) a title distinct from that of the Document, and from those of previous versions (which should, if there were any, be listed in the History section of the Document). You may use the same title as a previous version if the original publisher of that version gives permission. @item List on the Title Page, as authors, one or more persons or entities responsible for authorship of the modifications in the Modified Version, together with at least five of the principal authors of the Document (all of its principal authors, if it has fewer than five), unless they release you from this requirement. @item State on the Title page the name of the publisher of the Modified Version, as the publisher. @item Preserve all the copyright notices of the Document. @item Add an appropriate copyright notice for your modifications adjacent to the other copyright notices. @item Include, immediately after the copyright notices, a license notice giving the public permission to use the Modified Version under the terms of this License, in the form shown in the Addendum below. @item Preserve in that license notice the full lists of Invariant Sections and required Cover Texts given in the Document's license notice. @item Include an unaltered copy of this License. @item Preserve the section Entitled ``History'', Preserve its Title, and add to it an item stating at least the title, year, new authors, and publisher of the Modified Version as given on the Title Page. If there is no section Entitled ``History'' in the Document, create one stating the title, year, authors, and publisher of the Document as given on its Title Page, then add an item describing the Modified Version as stated in the previous sentence. @item Preserve the network location, if any, given in the Document for public access to a Transparent copy of the Document, and likewise the network locations given in the Document for previous versions it was based on. These may be placed in the ``History'' section. You may omit a network location for a work that was published at least four years before the Document itself, or if the original publisher of the version it refers to gives permission. @item For any section Entitled ``Acknowledgements'' or ``Dedications'', Preserve the Title of the section, and preserve in the section all the substance and tone of each of the contributor acknowledgements and/or dedications given therein. @item Preserve all the Invariant Sections of the Document, unaltered in their text and in their titles. Section numbers or the equivalent are not considered part of the section titles. @item Delete any section Entitled ``Endorsements''. Such a section may not be included in the Modified Version. @item Do not retitle any existing section to be Entitled ``Endorsements'' or to conflict in title with any Invariant Section. @item Preserve any Warranty Disclaimers. @end enumerate If the Modified Version includes new front-matter sections or appendices that qualify as Secondary Sections and contain no material copied from the Document, you may at your option designate some or all of these sections as invariant. To do this, add their titles to the list of Invariant Sections in the Modified Version's license notice. These titles must be distinct from any other section titles. You may add a section Entitled ``Endorsements'', provided it contains nothing but endorsements of your Modified Version by various parties---for example, statements of peer review or that the text has been approved by an organization as the authoritative definition of a standard. You may add a passage of up to five words as a Front-Cover Text, and a passage of up to 25 words as a Back-Cover Text, to the end of the list of Cover Texts in the Modified Version. Only one passage of Front-Cover Text and one of Back-Cover Text may be added by (or through arrangements made by) any one entity. If the Document already includes a cover text for the same cover, previously added by you or by arrangement made by the same entity you are acting on behalf of, you may not add another; but you may replace the old one, on explicit permission from the previous publisher that added the old one. The author(s) and publisher(s) of the Document do not by this License give permission to use their names for publicity for or to assert or imply endorsement of any Modified Version. @item COMBINING DOCUMENTS You may combine the Document with other documents released under this License, under the terms defined in section 4 above for modified versions, provided that you include in the combination all of the Invariant Sections of all of the original documents, unmodified, and list them all as Invariant Sections of your combined work in its license notice, and that you preserve all their Warranty Disclaimers. The combined work need only contain one copy of this License, and multiple identical Invariant Sections may be replaced with a single copy. If there are multiple Invariant Sections with the same name but different contents, make the title of each such section unique by adding at the end of it, in parentheses, the name of the original author or publisher of that section if known, or else a unique number. Make the same adjustment to the section titles in the list of Invariant Sections in the license notice of the combined work. In the combination, you must combine any sections Entitled ``History'' in the various original documents, forming one section Entitled ``History''; likewise combine any sections Entitled ``Acknowledgements'', and any sections Entitled ``Dedications''. You must delete all sections Entitled ``Endorsements.'' @item COLLECTIONS OF DOCUMENTS You may make a collection consisting of the Document and other documents released under this License, and replace the individual copies of this License in the various documents with a single copy that is included in the collection, provided that you follow the rules of this License for verbatim copying of each of the documents in all other respects. You may extract a single document from such a collection, and distribute it individually under this License, provided you insert a copy of this License into the extracted document, and follow this License in all other respects regarding verbatim copying of that document. @item AGGREGATION WITH INDEPENDENT WORKS A compilation of the Document or its derivatives with other separate and independent documents or works, in or on a volume of a storage or distribution medium, is called an ``aggregate'' if the copyright resulting from the compilation is not used to limit the legal rights of the compilation's users beyond what the individual works permit. When the Document is included in an aggregate, this License does not apply to the other works in the aggregate which are not themselves derivative works of the Document. If the Cover Text requirement of section 3 is applicable to these copies of the Document, then if the Document is less than one half of the entire aggregate, the Document's Cover Texts may be placed on covers that bracket the Document within the aggregate, or the electronic equivalent of covers if the Document is in electronic form. Otherwise they must appear on printed covers that bracket the whole aggregate. @item TRANSLATION Translation is considered a kind of modification, so you may distribute translations of the Document under the terms of section 4. Replacing Invariant Sections with translations requires special permission from their copyright holders, but you may include translations of some or all Invariant Sections in addition to the original versions of these Invariant Sections. You may include a translation of this License, and all the license notices in the Document, and any Warranty Disclaimers, provided that you also include the original English version of this License and the original versions of those notices and disclaimers. In case of a disagreement between the translation and the original version of this License or a notice or disclaimer, the original version will prevail. If a section in the Document is Entitled ``Acknowledgements'', ``Dedications'', or ``History'', the requirement (section 4) to Preserve its Title (section 1) will typically require changing the actual title. @item TERMINATION You may not copy, modify, sublicense, or distribute the Document except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, or distribute it is void, and will automatically terminate your rights under this License. However, if you cease all violation of this License, then your license from a particular copyright holder is reinstated (a) provisionally, unless and until the copyright holder explicitly and finally terminates your license, and (b) permanently, if the copyright holder fails to notify you of the violation by some reasonable means prior to 60 days after the cessation. Moreover, your license from a particular copyright holder is reinstated permanently if the copyright holder notifies you of the violation by some reasonable means, this is the first time you have received notice of violation of this License (for any work) from that copyright holder, and you cure the violation prior to 30 days after your receipt of the notice. Termination of your rights under this section does not terminate the licenses of parties who have received copies or rights from you under this License. If your rights have been terminated and not permanently reinstated, receipt of a copy of some or all of the same material does not give you any rights to use it. @item FUTURE REVISIONS OF THIS LICENSE The Free Software Foundation may publish new, revised versions of the GNU Free Documentation License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. See @uref{http://www.gnu.org/copyleft/}. Each version of the License is given a distinguishing version number. If the Document specifies that a particular numbered version of this License ``or any later version'' applies to it, you have the option of following the terms and conditions either of that specified version or of any later version that has been published (not as a draft) by the Free Software Foundation. If the Document does not specify a version number of this License, you may choose any version ever published (not as a draft) by the Free Software Foundation. If the Document specifies that a proxy can decide which future versions of this License can be used, that proxy's public statement of acceptance of a version permanently authorizes you to choose that version for the Document. @item RELICENSING ``Massive Multiauthor Collaboration Site'' (or ``MMC Site'') means any World Wide Web server that publishes copyrightable works and also provides prominent facilities for anybody to edit those works. A public wiki that anybody can edit is an example of such a server. A ``Massive Multiauthor Collaboration'' (or ``MMC'') contained in the site means any set of copyrightable works thus published on the MMC site. ``CC-BY-SA'' means the Creative Commons Attribution-Share Alike 3.0 license published by Creative Commons Corporation, a not-for-profit corporation with a principal place of business in San Francisco, California, as well as future copyleft versions of that license published by that same organization. ``Incorporate'' means to publish or republish a Document, in whole or in part, as part of another Document. An MMC is ``eligible for relicensing'' if it is licensed under this License, and if all works that were first published under this License somewhere other than this MMC, and subsequently incorporated in whole or in part into the MMC, (1) had no cover texts or invariant sections, and (2) were thus incorporated prior to November 1, 2008. The operator of an MMC Site may republish an MMC contained in the site under CC-BY-SA on the same site at any time before August 1, 2009, provided the MMC is eligible for relicensing. @end enumerate @page @heading ADDENDUM: How to use this License for your documents To use this License in a document you have written, include a copy of the License in the document and put the following copyright and license notices just after the title page: @smallexample @group Copyright (C) @var{year} @var{your name}. Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or any later version published by the Free Software Foundation; with no Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts. A copy of the license is included in the section entitled ``GNU Free Documentation License''. @end group @end smallexample If you have Invariant Sections, Front-Cover Texts and Back-Cover Texts, replace the ``with@dots{}Texts.'' line with this: @smallexample @group with the Invariant Sections being @var{list their titles}, with the Front-Cover Texts being @var{list}, and with the Back-Cover Texts being @var{list}. @end group @end smallexample If you have Invariant Sections without Cover Texts, or some other combination of the three, merge those two alternatives to suit the situation. If your document contains nontrivial examples of program code, we recommend releasing these examples in parallel under your choice of free software license, such as the GNU General Public License, to permit their use in free software. @c Local Variables: @c ispell-local-pdict: "ispell-dict" @c End: guile-ssh-0.18.0/doc/guile-ssh.texi000066400000000000000000000171311471416131000170410ustar00rootroot00000000000000\input texinfo @c -*-texinfo-*- @c %**start of header @setfilename guile-ssh.info @documentencoding UTF-8 @settitle Guile-SSH Reference Manual @c %**end of header @include version.texi @copying This manual documents Guile-SSH version @value{VERSION}. Copyright (C) 2014-2022 Artyom V. Poptsov Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or any later version published by the Free Software Foundation; with no Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts. A copy of the license is included in the section entitled ``GNU Free Documentation License.'' @end copying @dircategory The Algorithmic Language Scheme @direntry * Guile-SSH: (guile-ssh). Guile bindings to libssh. @end direntry @setchapternewpage odd @titlepage @sp 10 @title Guile-SSH Reference Manual @subtitle For Guile-SSH @value{VERSION} @author Artyom V. Poptsov @page @vskip 0pt plus 1filll @vskip 0pt plus 1filll @insertcopying @end titlepage @finalout @headings double @ifnottex @node Top, Introduction, (dir), (dir) @top The Guile-SSH Reference Manual @insertcopying @sp 1 @end ifnottex @menu * Introduction:: * Installation:: * API Reference:: * Examples:: * Acknowledgments:: Appendices * GNU Free Documentation License:: The license of this manual. Indices * Type Index:: * Procedure Index:: * Concept Index:: @end menu @contents @node Introduction @chapter Introduction Guile-SSH is a library that provides access to the @acronym{SSH} protocol for programs written in @url{https://www.gnu.org/software/guile/, GNU Guile}. It is a wrapper to the underlying @url{http://www.libssh.org/, libssh} library. This manual is partly based on libssh documentation. @section The goals of this (humble) project @quotation Most projects are humble, it's the combination that's interesting :-) @author Ludovic Courtès @end quotation Now let me explain what are the goals of the whole project. Aside from the fact that I am having lots of fun with the project itself (and the project is helping me to grow as a free software developer, many thanks to all advices and comments from the community!), there are practical goals that the project struggling to achieve. For me, the main goal is to provide convenient means to write truly distributed applications in my favourite programming language. Computers are getting cheaper and more and more ubiquitous, and so different kind of networks. In my opinion the question is -- how we are going to utilize those new computational resources? Using multi-core systems effectively may be tricky; fortunately some languages (such as Scheme/GNU Guile) already provide convenient API to utilize those systems. But what about systems that distributed over a network? I am dreaming of the times when using computer resources distributed over a network in GNU Guile will be as easy as using local ones. You should not be asking question ``how to do it?'' -- what you should be asking yourself is ``how can I use it?'' But Guile-SSH itself is just a library; a tool that can be used to solve some problems (and, perhaps, to cause new ones ;-)). So, as was noted in the quotation above, it's the combination of projects that may lead to the most interesting results. With that said, I would love to see Guile-SSH used in another projects, and to hear positive (and negative) feedback from you. Happy hacking! - avp @node Installation @chapter Installation @section GNU Guix The latest stable Guile-SSH is available from @url{https://guix.gnu.org/, GNU Guix} repository: @example $ guix install guile-ssh @end example If you want to get the environment for Guile-SSH development there's @file{guix.scm} file in the root of the repository that can be used with @command{guix shell}: @example $ guix shell -D -f ./guix.scm @end example @section Ubuntu GNU/Linux @example $ sudo apt install guile-ssh @end example @section Other Platforms Guile-SSH is also available from the default repositories at least on the following platforms: @itemize @item @url{https://aur.archlinux.org/packages/guile-ssh/, Arch GNU/Linux} @item @url{https://www.parabola.nu/packages/?q=guile-ssh, Parabola GNU/Linux} @item @url{https://software.opensuse.org/package/guile-ssh, openSUSE GNU/Linux} @item @url{https://github.com/aconchillo/homebrew-guile, macOS} @end itemize Please refer to the official document for each platform for the instructions on how to install the package. @section Manual Installation Guile-SSH sources are available from GitHub at @url{https://github.com/artyom-poptsov/guile-ssh/}. This section describes requirements of Guile-SSH and the manual installation process. Guile-SSH depends on the following packages: @itemize @item @url{https://www.gnu.org/software/guile/, GNU Guile}, version 2.0.9 or later @item @url{http://www.libssh.org/, libssh}, version 0.6.4 or later @end itemize Get the sources of Guile-SSH from GitHub: @example $ git clone git@@github.com:artyom-poptsov/guile-ssh.git @end example Configure the sources: @example $ cd guile-ssh/ $ autoreconf -if $ ./configure @end example Build and install the library: @example $ make $ make install @end example For a basic explanation of the installation of the package, see the @file{INSTALL} file. Please @strong{note} that you will need @url{https://www.gnu.org/software/automake/, Automake} version 1.12 or later to run self-tests with @command{make check} (but the library itself can be built with older Automake version such as 1.11). @strong{important} You probably want to call @command{configure} with the @option{--with-guilesitedir} option so that this package is installed in Guile's default path. But, if you don't know where your Guile site directory is, run @command{configure} without the option, and it will give you a suggestion. @node API Reference @chapter API Reference @menu * Sessions:: Session management * Auth:: Authentication procedures * Agent:: Interaction with SSH agent instances. * Keys:: Public and private keys * Channels:: Channel manipulation procedures * Tunnels:: SSH tunnels * Remote Pipes:: Creating of input, output or bidirectional pipes to remote processes * Shell:: A high-level interface to remote shell built upon remote pipes * Logging:: Interface to the libssh logging * Version:: Get information about versions Guile-SSH Server API * Servers:: Creating and managing Guile-SSH servers * Messages:: Handling of messages SFTP * SFTP:: Guile-SSH SFTP client API. Distributed Computing * Distributed Forms:: @end menu @include api-sessions.texi @include api-auth.texi @include api-agent.texi @include api-keys.texi @include api-channels.texi @include api-tunnels.texi @include api-popen.texi @include api-shell.texi @include api-logging.texi @include api-version.texi @include api-servers.texi @include api-messages.texi @include api-sftp.texi @include api-dist.texi @include examples.texi @node Acknowledgments @chapter Acknowledgments The @url{http://www.libssh.org/, libssh} that is used by Guile-SSH is initially written by Aris Adamantiadis and being developed by the developer community. See @file{AUTHORS} file that comes along with libssh distribution for full authors list. Also I'd like to thank all the people who contributed their precious time and skills to send bug reports and patches for Guile-SSH. Please see @file{THANKS} file in the Guile-SSH repository for the full list of contributors. Thank you. - Artyom ``avp'' Poptsov @node GNU Free Documentation License @appendix GNU Free Documentation License @include fdl.texi @include indices.texi @bye guile-ssh-0.18.0/doc/indices.texi000066400000000000000000000005451471416131000165600ustar00rootroot00000000000000@c -*-texinfo-*- @c This file is part of Guile-SSH Reference Manual. @c Copyright (C) 2014 Artyom V. Poptsov @c See the file guile-ssh.texi for copying conditions. @page @node Type Index @unnumbered Type Index @printindex tp @node Procedure Index @unnumbered Procedure Index @printindex fn @node Concept Index @unnumbered Concept Index @printindex cp guile-ssh-0.18.0/doc/logo-v2.png000066400000000000000000001506471471416131000162530ustar00rootroot00000000000000PNG  IHDR V%4 pHYsFF(tEXtSoftwarewww.inkscape.org<RtEXtCopyrightCC Attribution-ShareAlike http://creativecommons.org/licenses/by-sa/4.0/Tb IDATxy|\U?L.iYB4PqckYП* Hdty@[eQfB[6miiL&7!{fM>׫s=$|s*d:"""""=Q0!""""aBDDDDDi҆  """""J& DDDDD6L@(mQ0!""""aBDDDDDi҆  """""J& DDDDD6L@(mQ0!""""aBDDDDDi҆  """""J& DDDDD6L@(mQ0!""""aBDDDDDitDTR0㌞%*3(hatI֮tDDDDjc u&8SQ)W4-(~IՎˏ:+ B.ˬ|:\N#"""^0R`T.0fmDxKp>n릆:dMDDDD혀PN(b*xJEUlרMg\F,T>ѓX V+F+Cg2QbB)Np+=\~AqݶEڠ_[o):D""""5L@(%f^br5&^nk<@Ǒ>U*vNUpz2v"""" Pҕ/;Ҋ9plK/*9a%ԘҭSʷl/81~rE׈S_jOkT0=j+]ls7/""""g@(J=X~_㲦d.τ< $kޟd2."""lJ@AtM>n9J>ܾ+3!Vy1 >/]1"΀а}Ox D[/CޫRȼbI+, `RD5|TmWdTA黌#6#'L@hXN S,(+S5*hyJ #Ao[bR"Q6S9&Q#X4dn_h2|(pk*c,p?оoVTs*h ~ mS9&QbBC"55Fo^4uwbkENUKo\Q9*ؑ8Չ;~ʘ :ʪrs@aXOd.SVc:v7[Ro(0~rKeHD㥊uBh/q(83e?U9V\mUsƂCE:k`oT$.x!t zw}]8x=|r٪rp:,3^(H|60OTуg@hTcB0/@K*bk] RU/TΈ>񉈈꟱YUI#Lv"Rol^mT>7m6Bh&mtMDDDmР(pg Z>-x1f2 """(΀PRdyF5 \`X2gޚݮ9*zD'dK_wo;cޚTh69M|A=Q.bBISVy~* /g0=Tu}6+LtDDDDُ %U7yA(T<7g2d(OD1#q& teU6t&!hxI?vnkwfROi"}bS72QaB)Q~EU~4j\|!s *b*zecwwc#"""eL@(eJ=lޫ*Tl=XxySE~XmS›w""""1rBG}][4꼽~ pº"Wy, ; _>r錑h$aB)w̒ZR|s '@@S$ob)Yjv"TN0G hb;_eq0) [gt7xWwhVR]YU:D-Rq2^ 0UE& Է!;c;6< C{DDDD& vYbўg:+CwL\vX""""PZ|} %ph"#}4*:ihbBYdy'BH0hߍj~FcY@-U,*/C9+|i-|/٬bբ-%pgeܾׯl_c#"" Վ3*.x9dKw~* :}- `3lF#d~EDDDh*?kTLqC <`@CEHDDDDR #Tf` XgS?pL@FRo0&o 7hrugNQOUIcV;c=|+oF,& D9nFUpenpNSX77 ߙ1, (v~Eۆ?.L@rTE:+EK0>~8ܱf/]Vز{"Xf5|4(ͮ\9XwBnVϯۚgzZWh"S*˦TODDD QqBplTB6w6lGT~ ѯpY= *ODDDvL@rHYUT}躭K襙q(ԟ&ؕP9 fDO%10"""/4ðGpU`1Oo't%tQvcBWtYfJ>l{i?xC/o+3O߲xW#""`2/2?=~ ʶ6|/g$MJY}Ι|h Q;aa]Q^@Ơ˪H/oIÌ#V*{wK,nJ?3歙k}@IRoh%"",:FGu^ }8bX+Mhi~mZ}LJTzH&""(m1ܾ8oJs[m3n y-2& DYNG?Vm?%*i[bgxNM 8(1!bn_ae'=$*Unˋ9\fkZ\8qDžCgSmUEㆡGDDD Qr{YU6&R sg*Hs 7~=8cE޿DE%q铈rl2V z&/<*H e>3bQREc'& DYLU1"!5wFc~R؊dypjZ9 DW%*T9Sp$""(hbD2Rs {xL瀸ڌ5m~(71!b' *of .8:PI,7퓈rfmU#e]bIXݾ}5'"" Qv<\%;XQ$ug0F$KDDDY QѴZ] z?LF!tXG'_"""~L@['USSגշ*˶JVDDDݜԱ[TZf@ʪ |(.4EIL2ޗrXxy}59k] G%u`у/EIjDDDe1u<<_V? P$H@ v&"",( nkU91b]^AQ @*{h*'kLt䡠lY3 DDDe1:?NIFs)(O$DTo͛ =cmI,%2ػ%""3 DYLTH,ͩquO mm*?ݚ 6Wek (,&S]oW ^GTet}L3^&""(Ne]2ԾfWlUoFU^΀lݑom6&"" Q[_]`uB2pPjqĖ/^TKg{k;Ŷk*'z>}QvcB匫&J uEtΞ){tŞA?R[)}QVcB6ܺhU?CWy6#V="J`bKiʣ96&o"""~L@r@Cw/A@ѳmgp}]kc.qVGdMDDDُ QP(Q}n'`` Zf4v@t-{JZDDDx*}+_T; G6y8>Zʷ$R`UR%""(G8~7>n/#&yV5 RR0~;?X$p$""(GhݢJܾ'r_ 8Vp{nk'?lEcTf侞}!qFбp޲,tQbB#\1,طkج@k{8zMPe+ÕhbB#e.U͛ g+M?h B,XWHb'>} p{ȽDDD40!!en1Q]7mQ TڶLTUB~noUrT~qg/]VJ\ `5Tk}=EDDD nv(pwo{x wEZmy]"7\tڵscF& D#7ppy7TTc/*EWﴊuy 1Mx DDD41!aʽ-N^At4 ,@e@DǩT {Q٨ƺ1/oF$& D#T_$wʟ pƐoIF0& D@TDѳѾcc](*qFo۸bI F & WLD$T0bJNX~(*F9jhs툵vmJYKښWW@E"Z |c[De Dg:~"""mL@Fij"z8Tp8Оl$A;x[f#Vz&#"""dyښ7CEK,`3v*ʠf< D섖瓱-,& 9FRRY)cR$gq;XОȌqߡh^ؓ 'y """""L@r@?xS!z*V^7xo([W,_'/}la~KQdT_ Q9TO,L SgYp |DDDD嘀dK}8LULؤ}fBKz cXXӡrD$6O~o7+_KqDDDDL@\ѳS_x cSS7Rg2}!%zXf?Fv #E<*]~-[*% d~ּ ̅=+ `#֏o{j$-.\yq<NPK4h L_DDDD L@LNјcD`L_=}mo̍>6ȯ) |f کr?鎑 H/=Ԋ:/p#hc,sƐ癴f^br,T롉%:8b U/;>""""& )Vn,_@/;B Ί9n_rz#eUSU *_v9 zjٸbۙ$ܾKU*DPXϧ3\R*iMvy7_oͻa$!""")$Ѭ%{\DxRY-miqD)YjqFG$f 4""""$?$f% x~8_w8a>|*_SN3z%w'"""L@SIcjߞvjܴ_v>zp n2ub2n_h# TG6ݽvXD n_bU%]^s_=AV./[|ncXƍ!OC&N<EEA.e~){,#rL@*iL.@%PY!\Z&bޕz"Z `:wBU_"""4bҏK i~BNxd7/TJrAXM/ۑЈF& }( P.mc3 B_7n_h JK6FU *ۗnYܒdT' sjj*5[֯l_B4rCxH{bƮXxR8`]6>>FDDDl& /}k̇wB勶(D|g,0J+/t↠4}2Be-*:S|BO8n7ž?E"""F<<ZRz%zaSXGT9b]^AQOد T~ {-pB*ESDt! z7#ASNòV^ƐwZM0VI7Vإ7M]`Bj|;/KJ٪4eQ1f- 4~/1ܾyL>*7,\y>ؓ5;[N|@D4&ROxr5֓7]ioBe@KR_"]לۈO@ʽ2NƆ׷:(Vd VGOpƠo~OvēzL+>ojPY.k8gBtQ)7*g뺎[۽aHS `!y6s]{(_T{ Q5 n_S0)Q)zs$LD gċ8<~qʼTގ&;3;,ߍ!q}d,nŶb:mSBDDD4\#r|aݑ=PY](+{óm9 VWQg̴l.W۪>|Z{ci+t`>aܾИCDDD4#.qBVWt1칂'CVm[q9סsܸbCoG^h߲*go9*ڪ?Ch(FT&4Nz9rB_*oZ}َd`QBƐ-[xK/ݲsx,>؈c$ /},M3˴PX%8V7b,Kzxq_ 7]r ǥT zۢƺx '6""" W;; T¯jw#-ɎVbG?x:9e~){i8}z?C9vm_u8 uQtK2oz; ~:(ozq\q_ڪF7 O/T)z.c x<~z,^tGDDD4P9B,Ua?W[՜(~8tETBYy)?jeݯ)`ڢqC:f[3`tR-9F圍+(V<*߶U= يo0JTNt%i ?)qC?C~h0r6)w&s7Q,wؙhhkmрd2cޚF.>!kbS^(Y چ:TվK$. /) 1,)@B"""JK@D &nu Kn+*lU\?HxX{iڧc,WV}mG!&ZkvPAkEE:@U l!ADDD4X9zp^GYh.N&c*{-uET:h}aH[Nl*lUKʎ3;= `}%N ~Vze ^N% eUS!j?4Xk΍z:񓽗ڪ=N춗;~,m"AG ;[K 9QDDDDC3 HɂUS2wsKVLEӪye2..n_eTȋWX8ܓ3v{<>fz,ԮEFYb[7|`džh!"""H@D hKÕOg0,FH|৑6FGR)y,G4[͑׺^i3l+p%dɂUS{hdxXKDDD49,>$v3RƠwg,TV5@m.i@ VW[R9V:~Żjl]9R(*{jɉ(7_}䵖 pTdQlAwQo2o^D7lGKpL>+**P1.[<{}id}2SV[(+}!`UQ̂MۣEj;E"^)5noӕjJ1-lJʙCe40:noǯ 1Ig sjjl)~og_sѧtlC=̰/U+e3MU&e m_Z母G2]x{=){6q$g@JN[V0J=G }^ŭ?Uc &YB`'3FHZx8#9r}ND/ERm^z ~_E!x2_hg\mwo\+j["Th>7{އ6:a8M*p,s|*ߍR }U?XL% :n15WC鋶wRScܦx->|@e0^T@A*<#b'xm{ Oͼ|XīZ22Ԙ-OvRQ!乽{6*WEC޼d2g?(WT< 쟂!T z~oߵ:1 } 5P>Z3?|k0eP9Y aBv^ z}$ôuyEPW'AL=/%$*TUoHvE:ǫE)pWoy$Yxv2֍L>,KtzVBDՙJ>@p<_Qѕeް!Y 1Dܙc )okdODj"9]nrG/Mc]EeD 8Dۿ:۷ۆl`Kn_Ss5i_+ZtVիj[UV5u\[ ] @%fKSk 뭿T*t|ݚn }2 *4/'x,nY[/t"K@DIy/4H˅ԅ\ γ2D3?"MaQ~qnh}[S#MKI-蜦dAD*RScJNTT^{r/ Á?gޚ=XDlNE?\ zMdPYUTL->:Z֦? Mb\ǀ_\tUt{*`sc{ыMh?B-3!9n%jJb# *WT<'(̄K@SBǫ z+ 릨DU(`tU **;T;D2eE-Cz3u( P< ?^sR {D4y<~&1̩qRBEsFEYU`Ԣ z6+/Yc}R+X3}}Ü N^j>W-P]eXV#vcp۴)Yjqn׻\g|K7֯l_b)nxqC$g,'z_LRq}r*ki3RM=ZQs%:(,P1',8* XAe*ϋ(B=隈ƷXԧ-,QG [[ܾ+Py / RLѨ<f[3ёg~#&ƺΟU?'!O~KEWvfCjES4Z;Fvr$K%"J/4*?lĻP E3u;eV[*?E̋X2%䙞lWfAeUru@nXU ui-Q/*xI]y}3{58 y}}r췫UieLJ@?XǶs*G^lNVL7DnA!$DƴjޡwL|j(gtHM)uM@3?i?!y`Ƽ5p|* q}/%/Z1%^"%IK?:DDU AS]zYT~`t>gSS/p:ČD7|ƐT2P񭈿 l, }Rm6l5S(z@!@wsjj.HZUd%m[K%KQK=4m :ʢ!I9&ITs 'Jfg.T*A|:t_Փfm~y_ \?r ҽ*zj' hLٴ;l)CB<@ /s? .+lp̥Z|%D?2CK!"J9kQ } |ּN[f8 4~}*pNCtݴEJ\ DE/Ilp4+_8*iep<@lRuus,}E2J@lOtߌ!%f Hѹ_"A3Rƹ}.Vk ԛh_D߃lU7luoI^n]4NMs=9Zu4,s DF|]X"{[D_`(,}g֒sso ȀZWdVV}@hնkkwU9P[[jժE`Az}V*L&gG^; $'9{gW$g^#ݵbAI?R{>O{MkilCL$8zO],TsqqqqIz8I[' L@>b4|^U(y1&!Oho ۜ>ÚK IDATS? Ebj V[8) k_f@L)&i&^-SIʊoX5x1M&πF25v5߰N;ɕd.)m!2 !=q JiG_*K)ዉ8L}s!.G" |W Z~W=xSK7 >W~zN 4g#l}Ka#'QSWJ߰FRen )RxC{ۧpV פ ۔zh[oteS z{_9A2oɸ̈W"2[A<8Qn+zSz%Tjv( EyV ]@>z 8/F-}|%+%g. ėc7 O8T3tPg 5 c6i0SKAB#QRqRHLA&~y Uk]7|%8_{R8;tG琉D<=d\}YKwy>슑f/G}i3mƞpL<+& Rdd("K-f/ꂝ<-I6GL='Np6 JeNb`W>4/-ppK ܭ1-V<CA[;jC˗'o5Ksq vU>kGn?n*bZM3@jS>Wl|^f/[kzbH~z;D9b{cbEL􆓩- tu9BIu, VY rڵ75gX oV>b` O|\ԫ6Xd\>ĀuZ)CFCcKz_pXOvX:fl (i],W>C"I8÷ k߲R: >9h۬7#dbt:%BL-.{BEP lmN5y[*&T_mJ)7vFor1e{kpM)rMu]wH7]) H*Z@u[YK7ֽDlAjDNl7usǻ􇸐Khifp 1jk)Z2c+zťڴxg[:fe]+T$q(RE >'A6>%dk?}W^]b42ĿO N--ݷ* ;ՎX@) Sʩֹ)YJi'ǃP}فyk qٛiuHՎ@ijwM5L ..fewc&5Fa][~xKMS/iHM8[ւS;e0,d_:4G쬉_TT\jBi>|)YJrkL>Rk<+㾕 /+ͣ\Zpv=|Y@E.1 jUG#Qޑӗ{o\bVvS7l/1_ )P8Rhg;%K)!xf^(t~Gx+%xBڴx?t ʔ*TӓU\ZZ';|jPh5EMI[@ dka֒&D\S"j7J1EX3suq$PG0? R"|u2q6Vo5ݔ.Š4;Xh_4]SmQסo:ܵ@oɘ2_Zcʵf ؑghP5` DĿV&5[Ke(D1PNp|\3z[AsR6R|ԽaT~[UJ*.b]w !6ӦzO;#EYbKڗ^IsZ,Ǻ)Xaj[l/ֽD;~P  HLXZn2nCzԈwKYBԯb&@Oouk W_R'lQ(ߓb84}E\9n~aMs>mA.ux Kڎ=={hX?`+庹0ȨLA ^Ks- )&􉼃+Ơ9 #I|[V ,[R} mЭӗRJjJ)y3)љ>9`\zRLe9?ޯoLg >nl> (~êbs^zbOj<\X̴q!jd]^isz4"Q/6nQJ;By'TS"YTWxR͐S۶u={D|rqr]S{h嵵5 LY wBq T6Ep/3 fg2jƽxz/Z̻W r\ʡR;Uƻ<GW~ڗC&L2qR.‰$ | MKsA'A HÌԗGC<u\S{hLC- `R) WY>G$@ѩ<2PT>8ī]W$2۟炅4|V d\o:'KXmħXtA~gKŒtmj3ӳ7(1l4?+U`zT0MzY]PҠjL?'J9Nv1[hTd{:`ZS%zr vK\ 60 PU}zj3Xt-N:B6Pַť4Yt0GUjtqd]I-GC e"uDj+R) )mAo 4<}3S3@m#]h)בHww{+94- }=uFn =b@LP"Qz?.\K&d.΁rD'vtV[mH͢n8~@IlIN5)~ `Tڈé4>u ŐC=& _i.e5,--L1C/,k* `v HZb) BW=Bk"p-S &ҹV9_'&^73ť`LU۟;r,p3Ĺ O;" Ȕ@Ȯ ?/:7tVS0q\&+kU5 9Rbdɸ6*!@Q[Uofg6 .yq!~4%pq?Aė r[rqi-- CZ?*kH!?ťOpMO&գą#bS#pO,3JK%LW9_{#]ۥ'^olQLm0)hTv")]fJ|30_%mW41\JF$nk[;쨑m9f߰4Ơy) ݜE z?Mj:LE?'Jskǒa U xh߉QZ1do֚0uH*jHV VewuBUL  bhEr)!QS_Htؽ}@.E˽yK ijCv֓ǂ)L˻<~Z8;4 g2HaS* .BļY*HoPf(7SѲ+2 >tB04XNe1ޥW{=3@LXa,ZueY@R}_H7ZZJ $ Iy\JW韩66V]JCmV0Ôa.g):za["\m] KXu{Bqvxנ? {BhnF0~ K΃ E7d\$q9&ڎ(:Dm4Ry<{U]P>Sbv"r@.X=0(iSW >}LP? ;(Kz,7NÍR&_p4)]@|31]ӂ4"7xuF=2\B]ZT +,s~VMQ^c9X^qӗ{{RtiLمm;\#b)EV #QR J"_IL2 pRI^i B/eQ@i"㞊W@oCRmǥ^8$S_I|Rd~Y!2n3?C͈ `<7ؤj4?[7QH)Ԛ EKΏޘڴxFrhi@5yv3.ӠSf-)VGȈiu'^`E6֟XLӼv+p)!T́Ab@(]N W)ͷ0o\*?@ullП:&ˀ >GzrUi]os"_] Ș=w%M︐0|40pM ㊽FǘS  kroX4)ktb=ikˑبi^ulKw0I_7XiV{^fKK=tY ,;@]r8rR,XeI9I +_GIw/X6T ~JBRLL-/oXO25pӻwZKgk 8 I3"hJ!d, a(9d*WBeZ9GimxcU~5avC $NM)Q8kBhkL !7ASMcٲ Ar9$zۦ_0~-8,K``r}|1F:5c9UgDQ5 5.cm36 oZZ~Z촪5>j&ɮFz~~ÚiY/0=Ykk_NZ )oHȔ#bޯ 7}0%![`1M a(&Vb;B~H5L0b wDŽWjPB,XeW@Pa %tո٤sxV AE:Lg,q&+@xFL ɚϰC@ʿx{3s&\v簚!HW 'KolE)-RNNEH` 8影XVeF?74&~ԧ[kAM14Z2Vc]m{j=qی/&p~zx uWԋ^8teA Np4,`)c, +5=.P7KR=YJq]  3,}ZZxuvxHL@e1܎"(0.q"|1E 0CS_h.0l0(e ƦT TD,7)juQ* .E·|c^GHȫP"~O^p=GGO>x+:|$&쑚x 3bS 캡$2KO&-%[z+~Îy/K?H!"gxĀ .X$_Tte6( B&qᦨ􅆠o1]Xx I°:_->mҺ-$ L[ʠ,&>  ;=E/.m`9Sbf\qO M =Wgb#I#<<0$|s /@c@b; -&"ͲѰnIf:YQ+P/ ˆ:;﨩뚟[3l?$LSW)WC0TgkjwDǮ9Z'O;Vx=Ln1<ʅe{Op,'ð#S"CJl.UL_a+V Y =Rqb.XqO-G͐%O^. ~ 2g|ucӗk7^+@рcF;YNv> IDAT/Tì%cg Iq2 F() 놣6Wm0pӻA`cT\opr왈 u w }l64->Lh  9≏UOx=@^TCnz 1)Ut;Nkiƞ#g9 44rGͲ1h^L cŶDƾTFKK7f6WTq6=&n=}ZK Eh˥>u,+HLKsS7wyM&1[@?4Z2VxehnZ;j%~#Q yJM{}aƩ6t~ (f6ڭ}{bzw)Dv1 )F} P:4qv `y@|_P;$t$G#  | UGIH2&"h͕`vaV(Uc=e!N* Ղ݇4L_T7dW/(u! & kL<Xu axré$_$=|_ّ9QK/l[68'K; |1/ Z_$=|O4?x1"c #봂3'akt/< ~)הLjOF [D({aj3jΉK +l*PPrwͩ\ H<= |akV8(N^|OoϷdyy+C$k`[{qvhbo'7͓ɥ@ڭ_Y>OaI(?_0U` m>km3\(BQ@jI_33{8%R绎 TtӭYNTM Z$.d/<4ңYbNU_iWU>AB>lMUC5!j(_RuP>1GLBSMgEHEeah\ߡ.X.%$rP20NwqvxEjnJj- "Gv$ J[i( 1 [ȠF8Mi--fTFL}N5]6kÑF~%JH$=|cd&TS%:vDb(iA.9=d<ꄜVݤ2]0:0\\͒R^HaQKK9%`Ĺ^׵1 9[ȾdR- ,"BA*'L\qޭNI 4-&d+֡UXUļ;&KfnS{F4{ԑ=S72>5N2  j[c@rqp P bh+%9'α=}ɂN bʕǀꃖ[(qZ2m~eg>S`z5Y>raGL[,TWTyi5M2@Y|Xm+9NVTNiU[[ĥxm!қgNsHz[NTnEvVBHo,XL*͏&T/\y5*g,bdAb02[ yy5|Bd]EuBa:&P_!;ug\7,rS,Xi% Kuƫv,Kqϔ@'jzO\ȯC-H a]Tʜ6{X +Ȝ мYLe 0@&@E**,GļX#Ơyb <4kzb3eD!+ʥlDL~-_NdcBU1kZo!SρyU&j SLbOg2U/GW2KxET8AL-J׿7u1J蒶5(~(X&dTvP"ĀL\SJvS=6_PXUK{kIb2i=FbU$8+%o R<$M^(&R.XԴ)KΞHVVӀYo3d 03=v @1 F)5|q.OJtݵw?}Av+gfshւӗWmC,セ}Iëޖſ HlΝj{7 G|;7 &NRV/nPYzNLqD0.{j!~g4]3dgG..%Ņsi9O龰nԆ'\:2@]M15zD|CylNwd&g-3&`RIXg0@pݵIz=#˖]hGL|)KxѰnګ!J 5`ՑbZ~)[!< 1T` ȐPK 9QinZ^E7hV&,lم6gRmuSRJh.X~êQcbRL!"sI>úhȸK 17<~=!]ZeN }40,!r0) P]O47dE|z9ȿWҵ~1l(:'MdOVM/]\oR\r)K1iBT}k_n]VJmQ8#iaR9oolZ?- .X~Y@vzH5زwҧ*<XǤ^\va RmC)/BH5dX%ť$0j{7V49Hsq)SeSґL[nNwJj Mc9/OO_O"⪵ Xd+ v ^K 5 =H".X`:4uINR r8"}J'ike/&ޠ5)F:Lb⇒i]\*'c~f$ ݧ/v3Κz?GL"wt wЊA%d0U$w?yGr4Ld Ve<40"u! z7nq& yʝEҕt[ݥ {, D\JҒT,KI"cOfKƀ磌߸gX׹U q`&awk7?khZ|#B^gɂU+L lusܰI-|8)H 戭7_H] U@\Jγ CS)ťJssY42j\},W#'>kkn4ÆDL'bnQ 9Cƀf᳨\qEE49S R@jzj1AX/0[kɓ}U?J#dD]+NĔV@8IY\nSSJY$kJr7K5-M&Dvu؇o&7wM': fձmֆHȸax{x2P=-_}c7˫-- v[(Ͳ9={2pV7HT*O^QTŃ6-mֆ3JÓua$+s2Z0ӟ@|uYGeɃM_RYp;̸߰WoQ0ųeg@0dap:ȹSosXh-D|3 J;K([ѡq8>)x+cFEoϥDL}VaER\ )C<`X_hXR|/n滟K'nƞ.u_E>,=a]1gRjV@r]B9D\n2['q}&y@)$Z9^[{UmrMDtʨ38 kc`]W&qNU(I#B$6^ab3+% 8a)*ukLUdgNn4,9MuQˈa~|4+Eӥl$2;X3D ǽϓ~Z6Y팤77VైOHq8_ [gXUó;W.X]ض&*Nio@:ނ'@B=HN~ DI{=(j?!ʬVVZ_t1!G!i=PYrw0S ߰qF%6+Pì%c ^t: L_$zW4$8V่_,m`9 mu^U| 7  dM&ll1)j@zAxcn HBhaXMwc璘܀$/. @ *·7iNR@|u7_ܢ_N ݄ 70f)'@:NhW3aMg/m:fzmH~씣5wy/7 *zO3:v"n:0}7BУ\WU.1 q".Xj5#˸n0S}ڱkK\ sKJNJf$Ri4_~=4P T~5Cv EY"`ULL+ppqpyMnqNb?qDw!u`e部L'߰N"V`> P?)%0(, 2G1oK04C+nc];|P>|ɑ TY|Bg+WLTn\G24߰j|#'#1=S = ck:AeaWSӳK߰IX=\Srӗ{ug)qh7KdX|E'3ݐ`T.γ aӒ W^+G*l\D-dALv:ODž\7/8'R\M[m,mo&̔}$b˕) 2q6 ʵv3-1# VvOͧ"B)Swݞ:IN[OށI?b{#Qo 7rSdaJϪ,I=!: 3*kX[N쯴Vj w[H;3bz٪(vxc&ˠw86閕>1ٸ旜:aGNÉo ( b( 5`17u-UEĔMIθhWd0dz `tPk$FMwVn*۲LCu LL~olпPO8U0PQS/`JML]gU99߳YbzUB[6 $QVELHW8 c~D:S,+Z'7 ٙwB7GM}Kq JGӟuӗ{w=S 5oIs9H͂A⵵VxhZ,lJʼvAh5= )[APw}Pd'R* GdTnjZ SER('=o-䣜OQ ʫS__Va))K>lL2VAR޳̚[yy02.f T_ʽ(Vbik:M#,$&+ ӗ'?`T5!+l{BP\) 7qFoc]\D4@uI5/;n/7 + Z 2'bRV$:vKP2DPRűP3 92<'^"7  QUWՅtKJAj&# Ϯh!}'GJ(dE/1S6nTW@{  {cԆc>of[O]^hH[3j~"ȤP.Iٯzm?K&m< IDATQq< Hy3xYNw{S(1o VRP^ Hstij9/٦JpԦţzS -DGr!&XM U9P]lm7A?hZ`5w? IB(8Ʉz#֙˖]Xu@X+8_>d$)&֎#1F;krw: "\\RnסVQg`Yث"!F" Բ>V XHZL܊̗aHL[h۬7N 8) ).3*-Ьӿ'>i0WbL|EwwYwVԼfz' al܍$a:Y|V_`LuH%ԫoB@&X*bgjT!,Td1NTŜo?;m9տV ^ѱ5X- jw$U7ɓ߲"~̩SS*} I%Q Ό݄$xWے ^ˤ w Bg0aSZ#|dq6wB$a4s's_: n֖ xAb5fٖwK?^Ф CM~Úg/d#`ze! Vipss]  i8 "O_͐r˰ F\a}rT 7*`Rka1j0V{S:+Eg) Dd,"L]q%򑫀zULGLr đIz8Vn8 \Gz?| 7ӘBXf_:f1 pm\$T!D 5!T3x1? XdGN뜈JQ̽k GHĕR=% 뇬;lԤkݞWf*$^I .X;"H;찅~مIؠ&^b:.uM@'v%Y[gB Tk$P5IDL}$V]멦g%^VU@ȧ[U - >Jf2X 9- ~:6`Bu[ _6k'D8{6si29ʆ^r!in^`F+n O]3X24j 4vh隉\kI+&WgN)#!eO _9\ɸ j'>1h0;tS1! Ng#`$=|\os8FaQ as ^  SVhq`3Y˔2ո& 0944->AR ɫDLL +~D\Y Ȯ?P.*/؆QU]3bLJo@g_8%O{ 3e=I)Xz TX2bǹ n6ͱC4I3~Z7]SbMj:lm4vaoXʩxldB~  * ;oh1 l-LjT x̦yn ;o\7(!.s*dhXeY`=SW?ni@,&q>n{ 3d~|㫁QDCZ9 O_-Z2'qodF=|62 ҁϥ:8~}4W.T*]Lz~NtϰӭW$ B{ʀ5uyů3^nz7H!%~گ)l-7rQ@Xl HC)q,. Nga`r%4Ȥ#>h;r΃R!Kެx׸ j{Zx8UB9i k_@ࣈQC:1UTIx|-*JY Om5xW. :8$NF t$Ge dB--?TKerEYa;(nMUֳ Ei=W=۪Ddg6bWVŊpZVxbdZUj!>?f6;rgHeO>yQ_ _PM4{{sf׌_gmQazky?{@Xkyz1 vo.Uwƶ`ak@fژEDլ$VC&B6{u%J؊IH=u?ҢOaMK/m{FƚpƇj2*N;ZZmH攝mnԷ ;}I4HS(Ӊyr-)H; z7ϲVjV.O"Հf0F/&^']&~,X_3[]=shscٸn{wo釰-lY4ZPR&ƒ%Wm4[P34dh)M@y&gO&NoaiE6Z m 6_f!8;mC_6ܟ [b4@ik*mq^Ʌ#;5cn\3p C7;;ZMyӄ~F%%ǶGƇpfq$RFO& :da e9E W{*ЌkzgH/'g)U4X jv!HV@3n<*Knp].ҤRD(lxoޢXD;#wtuEm|z#*.hN2rD< kM$LGU㫎_Bဘɟ1 mGl9jGny`ȅ-B~ Ho^_RF!}reH~`Cq#tB *eJbe//7+ؔ6J_m*c,CyiߗGe = _ƁLpm*]DHHZ2;.yF̅_kҔQ.3%,i,E@LL3z1\TӢ$/mǼ;|9F͞_rc c'XўjpܹĐ[ `Xo]\s潃Hkx׮ǞxHNc?Fr% #x\9"=EWa#1-Pd+BU6T3eW-S5 ( ul$c6@&CՇĕt`_X&[]ٯ};Z&mRȼs@mRB>Cs mqD;y_~(M a+eQ1ĸrͯ.i"2>T}x@ L1#'~(+[ fB34\( \UIxVph1%]mY dX3pI矝cx>JI@~kۜv2ӴsэdJH"*51]mj &Me/Ќ8Rs.9 c+"G)R4tuK{;UV 9q.EYY|R"F@%c*"ZcsņA5z=/F6*ʅ={0ٯ܅ԗD:eΘJa&LKmYH;N~%\St`H!Pb2T5=^ u06QMB>;kGIX?Q #/>倘=o)lO0DZlBG<%liY|7҅cF[r˜)=>ihz@< W!r1{x8|`ăc40Ql!0 A B  Ea}jMD5HP^@&\`]ŧ*)%aJ0Q@ P翾|+˗OJX}{̔eHEm||DB^s95B2"~ fb!Kۉ%N:I,ݛpzaRB7]r@< {DvX;\U01I!  .c2С~+P6%)ZGu#O}|D@@aZ j#"fuHZ׌o&{09t\c;?+ +Lնz a+ j~sacw)U2񯐊Q&[3fʲA Z&F}h{{#yqoӯahU8*+g/u6!&{c?̢o[}yw+߶zѵ>Y[\L6 T]~d]h3.h^EECe1]Ma+?BFw*l`:4'$r1'' I+Kz 1怔3ٜSB~K(6à.Ќ *(@FjIg{oKdTѯFHx23 { N޳x:kS_ʦ= R5N d-Lr0H7H4z=ɺh{i=Ahݙ1J7z ͕=3x`-{^K݀]Qȑ]t/I⧑R`"V-9dC1)˽ `)g !A$KqZUcon%*'PՉcJ*7|tY $#s(-0WŊ|t>N[:Vp)瀸 ?c`:E0SX=Dq4SFR=zS1]/\_1~am5ta{/|nI|q&9ls%l6 1a<ǿ˗OJ)–ejDܥߡ4\L?{;5+bz# #aN:6ZI"RRadžqʝZr4?"'ӑp= B0]ЌWs(͸m^8N_ӂaJO$z; x ]j R2}H=Mߠ7;y `fWjmk_X)jlJjj" LGgBG 5eMu3/`S.X9܌>X|0;L(lbeJg:qһvy'`l*!Amސg|pJr|^׷q`:BLRF zgkA\!,wO.4:R,yBيw7YBG48ZSXTM-o` hHJF&#Na:|mݡ[gGJݦj4xJL%9Z$2{uFL=z0okLE`O%mޣ4{wO> lC)RLƢ_%1pZ"2i7X q& 5'~=J0wS4*`m !Rʐ o߲[Kqmy׀=GIs@b׌_`ʬ"KsL.۵xYYيk) /Ԋa^)$pYsb_,\ۯfuBI3O?SO!=IX޼wМf/8Nx, b+ o0PC5PjHbHIqٲ ' YLoiellFAuúNlе !b퓳lW( E/B2~d! FtBB"0 i3G@J[vHy/ҟ'jVNs$'R\@s2IHq"R߱]7'^[XQ׌ 0]Ʃѯ8-J: 㨲R8[ԩ:/Bgi{'a&Jv=ahcA9Óo݌ IDATl~ LoYPtfEI;:wf=sꯓH2p[o'ٗ*Ke23&ߕliB)ɇz9!Gqy4 f,/L8|u0v@J8M{<'tug@0ߠM{5~at@R=9:u@)nt(fiMy>l+u󉕕y(uDmwHI `k tߏppG/5:o-%03M H#YkCb:VWñhdOqK- >|.G/Bն5b=JRX*;mpee+X@3S=0' &^9B[mhWk +-e+0hm1]]zd/ϼU.B= eWEGt]X`@kFrJRnA*lBf}c>U~ҟ#K)XB^5̔dWsSp!U;,w=GB*}[qqo;-W„'e0+'ʩ0"0\h!>̇`/ 9˻|n}VG_aǯA-r$72 8 +d9I|bfƎTTl0Ug#34 @0<=̴?fࡎo2̔$!Sڼ7kK+ߥ":Oaa @Tks)RaB@3e2P$yJB„NlٙȽ3"J3 BqNE@jMlwcMEaݰ?{o_e п"ToLBȍ͘ռn 'پc(E G-߉E , ?&}m+őȁ鋇>,bdvLW hk|)ĝm/w1mHIU3Nϊq@9IHS:6"YBq mA{־[q2mKn VD g ?h= 4 ڞSH:7ZDEf` 'ЎS~FOD&7-->|M6Z~DXmuwifVs@Z` ieT R`I bmDcAΊzJMUu , hƓ8cCՇ_T6<ߠ%1]3$R}LG? [HXe%ql etgl/*Ia}|I#3k])Ug26t씘]8eFUF# Mܪv@i޼[dN(3m ݹS_ jƏS:d'Re dzzӖ5`EݾuliZmF>L;xz:fHQXT !?)XIj~xsKu?|bmQOX0@ԝo8/Fkn(| 5 kio`Ժe$f5SL0g$x)h`5f2ذ>J!>MK5F菭#+lgʎ!GgA{5%|.$.CU@YQ}4m< K(< &N[Z>6&C&00( ])(6@uWS{x#@;IO(_tԚ靪% O}lJiRK,RyTrv6}MG*H }ri"L|Vy L  qT¶pNĎ8nK R.u^Bt)$wBI^F@(L7"U:@jIxc:f:=]g +okƍ}H=QPw4x00H |-~ VL@Iؖr%K*IEmv(ǿf,)P) oQumNϱA5ziZ.}Vy_X Gʄ}4{nzILWy.}LS$4 MBR 5u(1v~͸SVOvDR/'$7m;vw#":¸g;]='e0ewӜ^HqSHĶɉ&Vv{;]ҭv4~G='9Ry퀬7Bɔ5!0F'Ф^gq6¸Cf<Qu\;KJ虁8@\tXI1#43dg|xkFVS8*+v%`+,K0S*A|iK 3h^ZTbos DlL=s>&mhs[Bt%O NWb\lkmw:ڿ0}"_j5NQUЌa܀fT4ckrZ9GT9b}#uzsJf Eg=͔MΆ%Sw8xn`1SZWOCat@ٯY=x&ؼq&~hB"'ײJLWh$`uʛ5:K/ ;;>ů4㟒e0MKW4.ѮrA5zvR YM2θY "&gMJΎa!}Mhw,Ug6+EBI<†Gs #wYуؒf sҾfxIːR \ߺN-&%\K?ԊalJS0K !74c@3ؗPx `!IH@PmD{i,~~'ۜF͵Fhl=G ]1ӕC|_E3'϶EmBݤ$Ƕa͘ `5tH94EK S3 *Ed{)O!z]gpzka"6T%5'.S9ժ0CJBI ~d6;$Eͳ eRT~mw!,)p.CHIX?MTn*V&'k: )$ PxgN_";dfI~6_}fJĵDZ}Bj]=>ADa1'T?(g5{~0*L|P0howVly80p15.[ttL K0ҙ ywH#K</j fZ]3>T}g]r&%܅&o=JO3z; |0&n ̴M6{ #$ә>D^(d ⓭֨ebhVwǎ*PR4 BRV.f٪˚_g f7oSRyhwy\4Vzҙ M4{A”#>1I@* Z&H0uw&陂{^HU?-lV7i h $qr ^20~ Q b u'*_3jΞ=j_f5wķt;@XLIG܀fl}eti"3$+).{ kJz}׺{.P"%/ 9fKBOlR_Ntn=omygo/pa*k0tt׺_/I6GʗH۩-޺L\?Tf&X`Z#4ߩ5Ci Y|>2ys^f`1MLk ]j|ѓ@|c߻ x ,wDc㰜W hGgb{amwgkL06.kɹ4$dsF2J@3IǑJh0״ fD@Jv4A'Fn/I[VOlC jƏ=OBnm5{~A;#TDFLm"GbfO hƱgWO` "tG,օΕ %q 11ELJϡYY-jtP_40A&Y L`X ;V16 %! &\0%ı1]-:-[ob\0Kҭ )fgj3-e(sZ-hy.zr=ށltFoKk +A\2@|_^!R{ cڑMu`a&N}ۛH_s--{z>' Bϭ#) k,8$gdOB ?_uZ./!%67)n/uODtd>97j5E*~0W0oqeTYyveQKmֹؚ[]sFhc.lawY#0lCoe=RdU)'#EGx+j|"-R+XLq9Ќb(X *5B.S$_⧔ѓ i?᭩=Xx"Sy~͈ޜppas_$uΏtjȜA36Qt{׈{jR#2y).ԕFFHViDHAL}H#E^LOq#j"c`uYGޔC\%a 0͵ 5W+{/z {mbrYV@m5L%`EC+`_cAIX?#zN0KO!L9aLlfC=okJaSZc`M|r1 @KʤկFLR鲘:2 LėH:Df;c̅a}Naܳ ]FIL|'-&.`~8e8_L\%;wl wD 6Qvv5CB-6&'(L(`ϚWs?ťsƇL!lLSV-ڐ+/}%k͸ h7Al/lGB~;=nLJNdpFA5z3= l5ӏj#Qі0g;~5z0gހf/x'V/v7R]v@jr281}gZ}Pўp%Rr~f<4Cj¸0=dqz`Z t1R)PZ)HhF{@j#n=5 Hod)_w}#d,/[E&!FeO`GǹǨ JbcS)L(S:0TJpqMU^BŠ3`1ʋv"Df ]?z@3"~noЌ^| Lgg( ܕgeP^fz[!4i OUi0;`kA5z9UV oP^Ќ'BrG$jmDsn9ZT8kɥ=nI^]gԹmpS'@lk:MߜwNB ZĔRQS^z3X?U1..mAX4#=1Cu<'^tn"64E]- h77Ȅnggg>#YSfT%aD~^8Q?g0 AqDwUU0~P7rKq6<űI_޾TY)1 "Z#Lؗ8t0hƽ~5UtBGԀf,)? [hp5Ώuq3mQIX !=s`2dz#lr hFPlԵ=)X /f1qH,: }51]}80}|׭\INkdOKӪFx#,:ktYut5}9ZO^pYm6uc~^QLn%('eu#1S w>Iq '\Wz~jln 6{5c 5) $'̙7 ghI|6280DZߙV-Ԍ'_LVDT[zMx7V*VIF ?TWz22 Ib`' f81ց.X)y*ws 7:?$£ufU n !M^ GÌfE.< Ii5w[I|^`{Y0il>TBh/̶ m#!YP\:pmhL(UO gFC#'aMJ}8L~ v&`&QB*Q;q[to &'q[Ќrn[a8h7Jʣ닪3ݾ5H)KfSg`;aYo'NLZZ Pe(r8oӯ{?ӈ{DLsi,GR t|TSY)kj rJXx=eFU/taYT h08XԌ;HռՓ:?_]WXT!oDٴ8 ee+ME!=rOh.EEn̚v1%a= CzlWy lNړ1B`*L(wZYe\踐\Ew}9YhU1tqA=abegזC/%[n ԁgk u}\}g&PY8퇯k踾_3n$3: )5FhYGkAa tT^Q8/=1`Q{P/BČyԌ%/O@FWlq@32 Z#Cϧ`%Y|Rbbeջ6d $'1'@b촥KԦ_wMB^EX̅~{Jڇx-IqO_OᢒPBVZVwhLeB[t )2>T}cWpHi/h?\8Ib#\IDAT^өX*&3΍}\!6{q 2p0jLۈRZqM-'hҞK[|RS 3f9FP3fpmL T#`>0pڰ&|}S+"y k=3X@LCm-ԀHޗi&)lmD@M`Jυdz6.}R5z4ď %!U4--m_'R`8LO:u ~2)Jp1fA\sRO J8O$) }`*Ӵ}ě=m)J/)͗B3@F5+nt%P-ŶRY-_SzIP34`Ko?3y1S ؿ)1L^i,33PC1]C+񜵘jbLS-;FsF@3aLjfZr$hcjZ&~9 +Anťc- ~ sN9J)磙'e+tF12 %'LFT#-A5: ml- h5iJfP0=3BWgЌ0a :....a;lC#A3n<Ē7Z5-OΖVlLWŒ*?rwN?{Ѐ?tcoྯg5cxmӈ YvR=2v5/tul!puǕ)\`Eʒ=` 3ťmj鉖 su07\x(_Pnn$srzM)`>C2>T}xR5zN`# iM^lR+&-"0,e=f~@iFnķ#)i_3IGigt _P3~R񶏶E1#tsO]\\\\R0lL כ \9>T}HGXD=8&=q=߅}U]m\Iq_3ٿ$6&FWoQY‚wu4#e RWz$({x\h a^7~5Z#\2?T}JaQ:AeKkdB7y fi|o aY6̨* jNLO#]-s!oޚڈ`:f$#%.W\xh*Pƛ\nBE0Sa;L7kAE Lٖ 8HF@2z#TP_ . ǃR5zj{ǻ?Vq+ M⛏/:m:Z޶ LLOh"TY)a}/MۖH|z#09Kodܳ%/Z938G@3j#2yf?{I=b#*I<$rc9GneȴL-)XrHoU:>BV0G {{i}=sE=GGzlL! F4)қ fj,ӵ784c~)%>EL2d)jr&~m|?&ָh2̨*=$.b5Y͸ 1]fƯFˈ8Ei ZdjCF X {bFl\s$Ki>#[}?k>b^sjE0E{ n`za;C'֧Nn+Ϩhd҆Q m(op;Tl)i3ja !~ =Y hW0*HENGۍ%KXi{Oo*R\ѿmP3d`QLWq#3_30 @XD;#; ȧfV7Ho2ڈB[ǺQ k(p` $d*>ocf箺Env(| R=5L?5B+n69"rW;g`Z7A =q!jdz_L(f8KA>bYL% koBL!3Bg/!P! !ߡ<f̨,Ќ~imnl\u@ڡliBl`dť{ Bu90% Ψ:F&LFT<5F1fʲA I`.8 @[H>f`LB$k}yN4jaM` uk/?dZ x5bZ]=7uN;mp|vk~n>zg×0߰ &>mYWuϝ+lKO!8!%'!ܷ*]󖉕m<їPe'+X@7,Gvi)ˍu!e)NIlMٸta}(xVauM4RxƇ+`m\>`OoYjxsR?9L`s1 u ӺfK*+E𓃏K1£$>?鏩xu@I0L.wRIf/ЌqbsUu >"1z[h9"$B/..++=7 5oⅡZ c(t5WJ;F5=@\\\\\\\\6 R7O5쾗Wi⩺dcܬIO@m&+ӵnZKu@"^0om@;onɼabeg#Kӹ P} O|A_sqqqqqqqq&̙7qKe ;`Z,z62mk& *RLp`X49~;`%Sdw7-Va{f| M)|hѦjQ=APVѲ"hc -r!-2Ku'E~>{q,p/Lώd/ju8$gZr&JV-O;6{ϷaܗVj/&q[$_V_4oI`&?̾1T;\I$RmZ|)pis- 6*R^}\j4 T[JDMݓ&mw*"-'noFClGﮛsPz%܍$r9IZƘNۍZvj۫e!b&Pg v2ɉq?G&@P UmoO?-jZ'9j͹_} !@` 3c$ϦSXIwc--P$ڏ̭o綯}7M0}Ⅳ>:53;ծڝqXLjeHn_{+:$kUmZ*meە1YIs[_8_6p @7f<8Ѝ @7Ft#@nЍ @7Ft#@nЍ @7Ft#@nЍ @7ԁ IENDB`guile-ssh-0.18.0/doc/logo-v2.svg000066400000000000000000000500111471416131000162460ustar00rootroot00000000000000 guile-ssh-0.18.0/doc/logo-with-text.png000066400000000000000000003771731471416131000176660ustar00rootroot00000000000000PNG  IHDRj3sBIT|d pHYs%%IR$tEXtSoftwarewww.inkscape.org<tEXtTitleGuile-SSH Logo23tEXtAuthorArtyom V. Poptsov ROtEXtCreation Time2015-11-25R3oRtEXtCopyrightCC Attribution-ShareAlike http://creativecommons.org/licenses/by-sa/3.0/^Z IDATxw|Tu?L̤0$UDbokcm{w{owz*⮋(M*0)$d23L̤^cɜ9B+|( "ّX2(!F EWT (2D$K.s}]+ Bz8X B jDDŃ,TQ U쓈5"VNog KӦ{ŠFDtՎ,L$Q|v2^w@!iԾG^ȈPD">v8G@neE(wlQF"""ԈhPfmqʝ 0$ #G Ř#aHCzU$ᴚ FD5k}EX3ւkS!zXxw/7JҬcQڈcP#eK& WLR,(*]duM3 )&`|b$IUqf=10{8"""ԈۑI$_WྃR2`n cq WϖNj5uA&VY!,+=N}j$ :F#AȲhe7QSSKUůU S''a봝5yyy"""Ԉ۳*/[vFqiE;H C@=t:-D7 illBumkQ]Sr,w kONiѸ(,O7$""AmYao@̨ǮŬN5D̈a֍gjjh/(Efv>̍=oHX0-X,ݺl4&DDD40Q۞Ů P8|, F!Ha,'ApPHQ J~9()Q?X|l tix\UDDD4 0Q& !B%s#q{݄x̘:5[kq) NIGIYBFEDʴNy+QJDDDo1Q؞cOQ"|}ҍnƨ(\S1N󗲻ReXZz#tZ''V e/ԈfkR|[TԹlcZrch37Zpe9~U] ]+oam+ ^[ :`P#"ږm'R/onw0-9 oqdie:ߧy4̟=MHUY'dDDDwԈke۟VMl Ξ7lK iaq<">s'$cдfi-BO0WlϑRU^Y->[i4͚Lq dNf0^_kr&..BDD40mˑ@s;b:mw/ˆH/WJ*e~m;2 };}Z<^ZȫԈȣO[;.MsnhdvzEV9~{rã"}i|xoU'yy̶,& vK9.cp [ F(JWŧAaq6K8hQؖm_h ;܆&=]HM :3b9^\)-G~摷Q_/NDDD}#jDWl77ݍ =u$_+F̨"Q&Q'{uXܷ6B-KV岉0e#l6%WvCK`cB`= ۬EI_dd/CSEXN›I)DDDf{&&*/ 9w1eP< u}uye5>d'*k!I$AF AҘX$EUȘP?IFFMQESA >t'̍ZƏWK/Z0y( cn>岝^5?߬X`ƥ+-Dw|zhd2dLV$ \@] |WN7-LjHMHCj1Qm4l>6ue{\^{Y&:vY9M7o*G"pA2EU*~Az<]7,VH"""7}] p9Y!C;|'^c1HʪZTVGT+AmKksr]Y1er"BRux%i[;w1 ҳU_^wּ*d4꼆qfc{U)AM?H_Nhpcwm>jmtbU.55v$^3w Ng])wU4""""5"9TcgL $u/.@1WkmZZF|mudXD p\eTDˆkԈ[dEeNN譲nY<|FK@r 0;es%T-Al[!n}1@DbhDXEXhbGE;ޛQ[~bwX$1'O_U1Sp #"""`P#k/f.|yIިOM8eRcaf5q+ $qG""AL@S<^O_Ij6jSY4 nU7QU #"""cP#.hN?lD-bHH+?_T|(iC]xks6!yP3g>nq " jD%:})M{鍒ՖoOˆcԈKw6z]ˈ]Q_oVUVZI$l7sj1NˆcԈS;M@YqDz jMou*ӮR!>vm9H FDDDàFD{t\وZK7 ۼqѲwm-k\O v> vDDDuN:|Dj5N \{˷kGWAM{ݨqz5"Wgdch$W} .65 ZӁ^k[2~PSg FDnmP.pޓ%6xb`XʸH,5@bHHPXHDDDbP#"rf֣ (*.Gaq9k^hX=6E@V$ќFΧ興Hu jD"4Av`5͎2 J_%:-F Pl wI_q"""ԈW,G_U]tɊ+ȾRS~ aw5 EsfN$5EQPPTl2_zz`0snu[$p2  jD+#juf?07ZzWpP#:*,SNF׭u%55b jDDD%V}t6fnhNܰ4YqY>&ׇ!:*"ak4/qG[FcTݝkL`w**]dFDD4`0[ͳWZc\w-M*w]0  jD=55EAڅL|d Qؑ52 z]幋mOHJI=r-Y_S^Q n'y %K0 7SZ!(m'HVT j27ZݸW]Hp'E ѽlv;.f9ݣztAq5PQ#ԈȭztPbkI赨79[x:|(+w=oxTnq:FǏ3`jЫ>27AuPU[Ϋ_yux4mVb6A-T_|ú_v5AXx 0nn9w!a*52Χ>՛Qzk_S5"In@Ec6W`HM;vvfN[o 6"i&ZSx*"""O]e&wuNgf;=[\_Fb<,uWu؋mhG*.c9 HDMDDD jDԩ;␣@9|ZGٮCods;i}K0-9#l5ޞh>:(`=UADZKJ+Q[נz-viKͣ+0w jޞXo׸XPTv8?g""""O`P#.l?& wy]څLzjqx}Zk?$8)B\jm@;=Q/ jD%K Ȅs!s>vXl6GV`xT 0g ߞɊ6t$EHSOXA=W'\5 luxsͪ-JQqy :uW Q]S">b9DDD5"2]z@s q#\^TKZ?mbip?9w9> /CDDD*`P#.[bqv.>v8p>UWo{;J vXQkp1=yE(M#""Ԉ[! qã"\^ e<.gjsu$ɟz"""RuqhT윻I9p#uyedꣻiPĶ{u"""Ԉw?8fT>_lq:a1$~mQ5-}y!"""1QCx#ݘ&!adc}ԾwsO(ʛzԈG$&η?~ܩ] >ۅ| W E>(H߇9n7S׿DDDH cڬd7*#ϕ"soP5[f:l é,cC(bө^EDDD65"8Esj+-M8#{aƔqx% #0@gu;u%.ik?f=DDD>5"J鿠Tc"`y=꯾ܯW?>y=<ތN<UDDDDFD2mB~  1u|̹RdC{ &W lfݟYyڲ8'~[gav$tw쩼g)n/ƙ4)B?g?RŒCԈH q(;[Hne&va:oxk/s9(wO#EDDDàFD P?7&a$y.4w "#B_uM=;zjÆv`" ^w""""On6K%"궝& 5WLe| g_ :(O790;OW{*"""45"R6F*0] Q5l3":?{1|vIU5"-H Yۓ/a]2 nfy©3Wx^,5yxK @Mgm%'!yKùje_)߻:- <ʐFDD4x1,M ]Epoً3ɒyxne Kf""""/G"W싅,M]oAUuBX<S''z>wXv9jT$g҈?W|(IM`߷:>E֯ oe_؏]uC iDDDXY(vfcт3sjs#>\+rv*?oz."""; jDg"^Ō|[-? 7͝= l'*N,|~rU"""ԈO}eD] hZ;vv:Gbd+(*éӗpMV[ؤkz_+~uDDDԈ_ؑdY Y=x {r{m^#ilGk-si3q%TjV兓oțQ FD؞#?(?u;vv; 0o ?_Oe +H= nPHl $""~A%`\ʸM[js2M ܹfR]kH=N¢(=LDDD jDԿm˲),/ڸ F;HB`q^yWpdfCvau{dyWѠŠFDҜWg~ KkHh0ni'CB`GYyJ*QZ^*bX"_zgF>FDDD0р6㙷*1]FB@h4!hAiY*Ԥڌ2(ƪз}zOZŠFD5kP D_ӊ Byǯ#ҏDDDD-ԈhИԺB0/PP_`tg{~k 9FD5k< "A(ox^/ B jD4(y!y< C"+F^C!""  j׬COB(?0YpFf IDATJB&k?kTN"""Ԉ0}Z_!EN7(@"d؏̧8jFDDDFDםnӆU$ ORtgF"""13R_@DDDDDDm13 jDDDDDDO_@DDEB}a]XSvM,8& 鄰,ޯ `[ ^toMrFF,q:{Ԉ BUB삢PǢL>ԈҴ, 3t".wh| jDDzna!iZ޹ jDDʎ,| ΋m/.=k jLF'vTi@M巀4-ǾG%|]!=9m}t""yh \}M1R4]xsy JUW?Vz_c0K[_ O/^4 }[ƠFa2}GK( @P_2\%Ck_{iڽwu\\Or'M2b O~4pl("m_(5v͊%u%DDDd4F7OJ\qes=GEOV2H/O@n_BDD41QPnD4lo(ٌ֢eBH$I DPP!d2l6uyLj#ujU26 Է5 3$(j6.V+¹Yp) {-Ibc¸$NЦ@YzO  FѨEs [|/YMM L&#] e& s:!"""k-c nZl˶& qNNcfCGp:-5{$$ŭ f`HhpUؼ"N҈; j18-f4Sjkkیe}]W"99'OFrr2bcc{3}R+1>ږm;mv;NG}4NsϷ;*ky0""ud4-,/멯GNNۼ~-$$7p^)`z#ۮ,69;( Μ=N>> Adx(BB!AEe()c)4~t.ؤIK 6DDDĠ6șƉh fydYi)`ꭠ hɓ1zLxFzWF5y۟0}QRZ^1GbaGE"4$!fEe((,EAQJ˪:]LgDV. )O*:`PdLFB9x8s F#]I&9F CWlK$r7Gc59b 1^Zd,<} ׫쏎~~uY_iZ(uAm03<^üu߆9s'OĩS[S`ɸ馛0w\tvɿ{PYC환H~eFl 6 @ì0cxh/*.ǡciH;o3DGE{nG`}GI{H""f2d1{l,X3g΄ .8Տb vÎ,L=Ҳ*lش 5iIXr>Es lڍ6ǧNN%]Z(a7ǡѣ R jh`ZqaܹG}||A+88Mkhzr]]JKKQRRR|'7T}k`9=x^x7g9=;`رQSS&eee!''ǫ !0w\^SLq״Zc0k8m+˙y 6vl,=q\V\}z_ ׊B,ZNM Jj] C-?X/=橚3>f2Fh0n8`ƌHLLĩSf͚5\yy9^~e: 2oڣ>eYF~~#edd -- _K 뮻p뭷^_M>JpE3[W Kvjm:nlH}%^׈}pN&'S"9ow]ձ3FDDc j}d4FxÀaΝؽ{7JJJZUCuiӦ9݌[ￏXb{HWk/S{Pe>|:JJJh<8Lpp0VXUV!22U31y~dkfU[sgBp챠v9LFXVV$ sܹspB :pǫJ࣏>Ƅ 7VXe2MjE3/b~OrP{ǭidddEqN f0 ~.@zc\@"-^q3n#`uADDD)5/2Us{r劚ݪ"&&3gDJJ &Ol.BCCh"l۶ | nzPh4eBѠ HHHw mz}/ݎ{b޽HLLիq-8[-roLF{^j',MgTZۅ /F^~1fOƼY{ z=ORЀȭt:9aA6BQ2{UuSd4SCĉXn|||3gb֬Yq@G(xgpPi[=}m/77>( )) i˖-Cpp06l]AAAVTT°rJZ aaaNo af $y G\#uM[ Bΐ`ܷV 7ܿ :3,*n"9KA2)+qׅ]8a&q$u̙3ju+5kf͚SBu~Q79gơCcժUv梢C[wI 2233gn.)7|p >K,سg.\UB+++}VZnsk_ ~c0~hM_6"@_`v\4 cxTC04"6\_E^~QEe o؁ݻϟx衇p]w9[)1çzj0$K`446m-{W8#|H; Y}^os رy}_'÷ykx)W7'""`'Ti& SOYH ƭފ_|7x=WB$'';]'$IMLV+썈u]x7駟^@``ڵk#`׮]C_$OLF&q@/McBڄ4yͪoh[AVd7WvAyEZm#[SYm6:b0T^іz &Q`;駤 {1ٳT3?0׿/~+,\AAA_2!n6m۶M}}}QXXyC^PfyjիyU 4iD77n.))G<8qDw`2Vݞ6CŒf{$a98_TmAeeO!7'""N5F_OiUUUezL6ͱHxxv>#͛zjAAAjsm 3+T[ee%ƏS`(//wL}LA`jvբ)0vu］ߟB wrkUVXd ?--:?̍\[Єx4/CDDDĠ"(\( 6oތul6[\'LgŘ1cpeL&L&UVk!kƀ( Z}xx8V^&۷iii] mǏlj'poqƚ;c Pp!5WSpy.Ky(`566e544v-F{|c"">x'?)x P̚9ͱS_oy9>?|j{m2gOmnQ^{5lܸO>dS_5y[ N8a2STTFBm~13;e"4֚hkK~V{=DCꌈJLFqw6{t,Y 6mڄ?O͏g_+$JJJѴÇ##x衇a˘>}zϳY,|Gx_{/>Hm>?DBKl22fhMkkWܫ>kl-5mGIZhQuC#u챀ٳgc…9s&|}}ۜgpYdff:۷oƍ#5ָq͆gϢ̗3MMMDee%***PQQ:f444@bՈ,())r)EQhTo[ߏcǎ̙3Xvm$I3g̙Ʉ-[믿Fmmko`֭/~$-&qc0no+MCcŎgZkl (0U5cEVE.AnGe֣BmQ?K&ovEQ_`ڵhlTwL> .ܹs݆___'֬Yyyy֤̙3n֭[\ Ϲ躰A h^ȒflFcc#fsϝX,@DDHH gO<7o˗]s={?&_JL/6^b[G4G llEjP=v*E޷M/KDD4H0hB/ӧU%&&+Vŋsll,{9꫎c ,PR@FFchxwzԧVEBB&LELڽE:444 ף&rJf.&9FygW !OzK,%Kp1_ϟwVe|8t~c„ K1b ^SbHhpSѓc۫q=zUۢGk[9-"""jC&q^Q|xwTEh4;w.V\Sv{/kVXǏ_NU iiit._ bȑWll,VV~lllDzz:rrrڼzTijC]]\ⲍ$Iİa5jԨ4 %%7nDii){1=_RRRT|HMMu.77/n<IGMF1^ 01?.};Pl;!rnB6+n~f+=^hAccR". p j=`2ХBE:t(-[e˖K/t 77~_ҷ; ;;iiiHKKùsڌu^Gbb"65w+?Ce?o3]t e(..ٳ7GǸq㐔D$$$`ݨ{Z2e Lc8vX6`ƍ8|0~߆&$$|j2ipRb:$y[j}o؎Ҳ_tZ̛u||4jw˂;~5Z&izD HDDC jd2G `˖-x{=&@JJ V\YfA]3((կ%kdznjRF8uΝ;ף2V3cĈ=U6ln$^|E\t .]… JYyy9<:1IIIDFFFݭ铝0a?#==ׯǡC:1Lxg/bѢE7{)kM?74 ;ڄ&Hh IDATێ0'C喯3yHpmàFDDC j`20%%%ӟr WWbҥX|CaW_}ƍ{onn#h_LL &Nx5 k֬q,BۍԴZ-ju2zɆ466ǎF#؈:|o7n8#(?'&&_Fjj*x dgg9oX?ϟ?/|}}ph31<)o_PC ecӒَz}۩mFzGȨ cGoO  j]d2|Ak.$իg$B ?>}pBΞ} ZRRR8q"~!}hj_Y~S ]/QK".&kVs HĶ](\m27}/SA! 7=+<%9|.:Ӕ*u됅tZm3`jҒ6mNO=fS6ݺucDFF"I-bҥ\rs4W) 5jD۶mi׮*)Q&Mpq.\T*HMMuZBN:ԩS={Ι3g8uNBѸW#Kll,w6nꩧ[.7N>ta h"lotc\vA}:K8k$6qwya8}z|+ :=*St}2}XBiĹBA]SB]'ZIݣ/]Ĕ)Sl6FМioLƏٳg{./^~ܻ㽼xgԩAAAN1(J&MRgQ߿$I4he]vk׏;w(ܢyk֯_96mJfh֬u}7oΌ3} 6l@||<9e˖^Y}'HR RYHIC[|ԫkVV|Qq>2-u~Q>2IIM7nsZ΃@edddddB:v ޽{={M4ho#+4 w&@$VB:vHpp0[ݕˤqၯ/7o:@rr2N-Ԋră`_-TPlws[<)B:Vvz$+W?4&M?~K޽ݻwgqUVSNӼysx375k$..tO?Mzzvr=F jݝ͛Ӽys~mnܸF)s޽b>Jܸqpé\2:uK.iӆ9s]WcccXhUVj׬_WG|[AÎ!CG:Uic ) 3{L:c}-.{Sm5EIy/o0ty+-ҡM :9t"'9'i*`/DZ||<6իWӷo_D{f?3x`ΝkH3? 5k0bĈ.@ΩS+WKK#&IgϦ\N`{iӆ -̙3۷ojH0a)))O;\n&s%,A/֕ yӾ]a+%.>c*M<AЉddddddphj=tZiGe̘1\zժVʬY6mYعsKn޼ϠAPܹcpڵ6lk׮e_ӧ6{qHi5WGԶnѣGqڜcܹlڴ/^z%&1իIn{>̓je@#Kcׯ_ϒ%KMP(߿?Æ sn?550BCC힣 ]{g>rʼtڵ>|8G!66כl0j֮B$֭[@56W;wsq16mġCn`RGGG3gΜ:v} _K A,I5Q˺777zuĦmHMKG ##lt9+oYv>k[ƴӊU>ex^ Sz<녚N h߀N#I|Ѯ9J%|'NtZJC޽{̜9Ӧt}|潽2d+~MAѴiSoR+{[\2xyyy.q=~(77dz inn1nnnt҅EoӠAʔ1"e޼ym\o(HCB*5W Ľ{t,)edg۾՟izQ+ 5V+ioE9sel+7пsk׮ԩSSNfZ-ƍ/ !!*U0f֭[ǰajT*4i(o>wV@sUT͕BÅ"FժU^=%bj$ٜ˟ѣٰa|~~֙`Xb3:t>`FEtXMIFuy^4nX}wFn^lg2%A}wOy W 5V^})9s&v86 0jرcXf N29.77ZͨQJ[oO?2:QEhh#hj͓Nn0)I /`ӱw&))&MEYj| =J;RÇz.NXvR2'N9Z]yl%UX#?~LF3a09:j_|={… ]n /$I̜9X3/2rH~#}YV\IHHS^y:u*ZZZCZsPL/^HN3t:?QTxz6DlժӧOgݺuvp$qڵ猹.y 8Yt}rr\NJ3ز#x[P mL D]jj: zƶŔ)S8pqnnn7O>wwwVjTR۷o3{l$I"77UV1f._l5jW__ts:tpɼ숚3jJdt:[QFNV[xʕ+6 dNCl2ƌիMDdZۗr j% 4vE1?7qٿ?(`RK.1o<ڶmkA$<<<9c.1}%QtNgd8 \>p ^ ]:IsJ<_!tZm{"ͦ«t&L'̎kРaaajC⋀>ʡjMk֬+V.ըæRJR˕+JCCjpP۱c'O>{Mݻ{ժUVȜ9s޽K (Jrrr4UcE8ðssr=rHs==y.c<cJuq222222OPi.)))|G"PT̛7$%%q{xx0f[jԨQ+{4i5///g,0<ׯO?99tq+tĞ5խ['/0x`ȴnsɳ k%ܽ_ o\IAx[5:"######c_v!:)Ph Ɍ?X*W̼y(_& t?̙3Kh0qGa IYYYh酁4Fqrssudee]ˋMB6 \3^HKK#//ϪڷBG||x5jC a֭lذE {𐲳53Cw'6_ϋm1S+}ru/RFFFFF j:vb1$1k֬b_ V;G_Y|Ղ {1dA`رt:;ڶmwlڴ?ha OOOuƀ\RKgډ':uYoݻ`T*iժ*b6//m۶6|ٓ7|ө"ME_^HG>v֭[m2?1P(jժ69kLb;%i?|7m∦]]ɯ$5̧jek(H箘ڧKs}222222O26VT.######Sj<5V[嘸8LbVy{{W_QUreΝZ_~gƌlm.\ofr_޽c\jբK.Ozj6mDnn4h@ҥSC-k.xfkի&k%&&F_VJժUiݺu}999ǵk 9{,%!!ogҼysZlI- E6oL]&"""l37ݺu[ndeeqQON2el8d-ǖj=BUP;1]@*AV(rg>t(- 1Xx5"!Zs3\rф._7qåsy0mw駟2T*6m5j԰8B`ȑ4jԈٳg3~xza풊!I ,`&w֍>y… ?cӦMZOPЩS' z8[1\+bccΦnݺN[SLL }Xwww/޽{:uӧSZ5j׮Mtt4wpŖ'>>;vPZ5ZhAӦMپ};sٹ;vQFZ7ǖ %$lÄ- k=*,RA:uP=|iT.U723fffgddTRbNՔY{(######(Piu]vL&MTȵ>6%88???>s̙Czz:iЋyQ7йsg>S:mۖ(N>mb\v~OOOˀ,= _׻RCVgP^=LB 9rQύDGGh4fk Abb"SLEƟڵbS|yǖHLԛkT^NY~}/N=9Y_0ߏ=t$le4*, ny KZӯY\AZl0T}L _ID%0;9^ | q"Pi {*""3f… fݛ~ٵڵktR,XEP*צ9.\XHСSLoQQQX X_]b tڕÇ? hogPsVD-22`U7nsN K/<:pG1Yܾ}"""TڵCiيx(fw'8N%;򞵇Z}`|e?(`! X~AF1l/ y|*cF [_HF]}Z!{9F=R 1+##### 5[͛7eʔaĉ` UdžￛĴivllѢ:uG1z*SL1e˖$%%zI{ŤA:eM7cX +W""Ç7;` VNNǏDEEh/weΝܹر#۷)M599cǎ_lݰVX/Bm9/n.(# QKRBTaL"ٞ|?Qeee1{lcsԩSYf⫯L2|ge w[?6ܹs!j`ǎ|S(?KRRߟxzzҾ}{ڷoDɓ'Ͷp _M޽;Z֭[;w_e?u(tP(* $HW BB$thhI'\`3` I"n#$:z=D"r/{ޭ!’ͱ/W8.j)T!~^^vVvP\e222222 5"AYYYL6, FAL}fԩƈOAܘ6mѣ+W$&& .PR%&O̥K fҤI-[):t(Nr\P|yJeMK"jF (&mAE.]Jrxkܹ0}tܚ5kRfM @VV'O>|e&FRRRNիWט*? &!̻PHHz] [K Qx+ eBDhQXGÐˎQ~ 13i~x6[P5j<>Sp=2BUuo#zQ_SNN55p 6lhm' L7~C1_YNz (tF̵t޼ kQ`:$++Pȏ,B= 5 A RhA;=_:E 5CE*$>?qiF}E*dF](*s@>'g9*d o_ 9####ak}1YvŮ]̎O?uֺlf޽fZ"zB`Ϟ=DZٲe1cSEQ9}5ŕ+Whذ]:tIMKMMe޽t`dʕѫW/IHH`ho+իWO>dffҲeKΝ믿~i%qO_MCrr2/_6lda,@(_ڞwA_ WjHlftQ6`H3t_%F+jekPqF ><0Q~}&tLIԨ]wJDQO5js]Q>mQ-jԮ)2yb5ꚢF]/?r/#j:SPqUܘ2eS :l̝kbz裏Je*T|jWŋ]*Is|2*ʮc -ʗ/o tJ_A~g2220asHٳQ|`UкD:t(AAAzj~ƍGf$-[Y|F^N8$I%5Bz&7 *Qpiꉂ;&$꾫9fKQW@oa[3^Gb}-oT \zm4UFMl *z-7jy(u?$0 ,j #Q~A5jg:'O_ @ lο0$#QJ}hKw}hrrr6mɫ̘1T$I̚5^jUϟOj\W*ܾmK\rwyYYYr=_ [nԯ_lrrr1]p[NN+Wח5jPbEKre~WƎ,<<V˲eja`@$~gZjE o߾ۗN>MTT,W#vZѣ ǩRJ麙 ]G[sz>Ct6OxP]8d-[Ԩѻcr;S9BpqQOTBҊl/C ̀qs`=6#jԞ<Հ'eQo] UթFԨ_Gj<}TBb+jUxbP EԨGz+ UHLǕGB΀FdZ_r&M&/p aaa&A`ԩNķ~[ݱ|̛7"@rrϑ۷IMMeϞ=ܽ{d߿Ojj*[BQ^;vph=ӦM( )IsΥI&5]zZ'|B͚5\BXXqnݚ֭[JLL ٳǤ#emF^6lMu|Ǐg-1Xăl*=gi,Evo:sm%$wpBڠ[i8̐4tRVN$// Mݑl,䡧 &^O5u UH+Q~Jzxo;*$4g@Ԩ_~E#?8}?%CPdSvG|S>>4lJetTռ[ԨaOYe˖qUV{6wQlY<<[Cg/DAꋍB-_\[WʘJr5QPp`Oo]\ jg-S(T!?poըQ J2YȜ9scvƿ6lP{s+Wӿ &#ԶrYF8p1|y^O*!--,a̝B%ovx׊40//Pd jZO[ MFԨ$w`u9ϣ7D/ʛpv*gr)]ģ" ЊAuhzGON^cK~1<gfk D˘FԨ U"j(<c;֭[MF^}U(=z4'Ofԭ[שOJJbҤIddd IQ]Fdd$cǎuKݝ$733}sNNTfΜPs蘘yJ'Ts~ϙҥK9x &MLJm۶Qn][;/D! 7W-7/B *@-` p (V<,jQoTB^U4yXߠzՂAf97y…Z8>8ihމ{QVB.8qFh%&jN IDAT0 5V(Nc޼yݻwJT?>>>1xW^!&&?ŋ;y133I&q֭BGŋ/h]bEڷoOdd$.\A-({\9;a2T`=ѣ$''ӼysFI3Sh4;w.wܡnݺ\tү[$ NN#""///i߾=5rh˗/УG粆6o̻Kݺu5k'N*n Of9={0tPʻ:BUރon9` zG0` /I j;Kƚ[s:0lf᜵G8Q>X}:A̳׋RόQP8~u1BԨsYh 5N"b `.McjoF.F GVF&2aF&#;;iӦחW/p޽b?cʖ-ܿvٳ?$/X;3hРbCdd$'N(VL@feesN֯_NkիSJΞ=G}DΝZ=W_% BgϞƍ97x\Z-ϟ7<,۷/AAAoߞg}J_gƍ9K-ʕ+fmZbɒ%,X |,X tR %yFX)joh4 g< 5]̷E Y#jԿ;\5IԨ(QԨJzRqBQ%(cKv?w_QD:K. j] UHi^lrw# [#9=L L5π]*PNm[+VpR( &OL2e<6ٻwomW'N/$"".]8t%KK .1uԬYhk-nnnƈLrr26m2)lKۛ&MдiS5jD fƍܸqW^yŦ5Iʕ ϔ.++˗SJް-99hΟ?Ott4ѥnAdd$@PP uMNNf˖- :TRcccٽ{7ƍ+vÃO>-Zjժxr(爡cBxQ Vky4ԍZVY$`'X+J-bK@ I5I 㽁u5=.?O')olqA*F=U 16/k*T!Z3c Q.>4)-DzBr2MIԨAO=kh5AOF]Eaf}dF=A <<ڧj 8oM3[̂ga̘1% /ŋi߾M lڴԤINZb ת(Jcb?>v"+rM/M6iӦ4k֌ڵk? ܾ}e˖1j(ANNzv+<<7o2n8<=K.0Rs%IڵknW\qa5Hđ#G8rg %>sΥRJՆFZӇz_88lw=!'GBt$-ޡt1ϑ^.rCK5@6ˍqSV4p}W&mY1*䬨QorϴբFዠQE峦PEE/UVF|>1M 0 >s3YB\{EBt]gEu,0z,G1[F}Jڡ>@h#"jg>l󟣕}7PBMDE$1o<_\U*Se'X_Zb]S?,\жZjW_a@=Xr%w޵9 Ν;Ǎ7HIIa&ǸR¬iӦVȑ#oQoߎB9gΝ;]ի(~~~ѳgO@O9y$e˖VZ\z*QZ˗kѻwBۭ[rA[4#&&Xʗ/QQQ̚5 ҼE&MX|9ӦMvÃ=z|\dSnI|#TB6Mdg W 364u, D\gFK ʿ [‏Ez"TlPF 1Q2Km`QP.q*}]j`Bb2<'jԁ&v15QW_k{XSȚE{g&jgbC6s-Y#j3_p@Кqf&SI},waMo@6{{VŭuTV[VCmպ:mUu޸W * (C69@ $$$..sB|o(+U?gWy쉬gժ?~wyE #6#;vЪFϞ=󼙳5!!!z%@3g4Yڵkz2%Kd֬Y&໺{quZdB8$qq~7\M'(]ف7Cdj5!!!mۖҥͩb$%%_KM1ݻwsYx1իWGE߿OHH!!!Y l),__~^{ҥKܹխ8-[ ~5jd{dɒ̟?˗uVϣ}~B AȪv$DPh x7n H" sHMtŀ<>Y.?7vJWQj xܧ4E˯2_41%HY@bVPeeU /C~ XjU+=e˄e cA~ґ}2}߬)( C~YT#Z<`/@*`rOaq8s\Q BJQ9!vȯ CQLp*CeƳ'̪9b)PRz)( brO x뭷hݺMfbܹڵKRJT\K9rN ,0YbdXQ0Djj*',,KTITkzѯeqFvɊ+ N8cǎ1gܾ}Tš5k\^ѣh4̜9-Z6::3gpiΞ=K|||m 777cx{RŋmILAXl. .4΍+V-# 9 "KaD$ _%y<"w^>vv{Ea! PA|¤=D/ຨVuFjOoZ_PQ:9ZLJ(K{!l4dggxTre r-z9_@M~EJ tW#2C W6Z5X RXوݚ2rn=g4U{grл1Ө=#x,33='PaUf)S_W9J$d5=ȟ#Sn۸LΨ} `ѢEf -\|˗/SBG=lEBB>V(?ަAZtt4cǎ ҔJ%SN5+H߬MD&>>;vm6?NZx)Sp%jԬIժU}L9gΜVZ&±cx벖dIxw=z'ѣs ޽;ݻwG$_ΩS?TG5x)UaaaV rԩEAYE:g$Jw=Boz'$9,($".ޤԼxR$Rf}( ZY:{ӽ/Ue"WYkD&5)wdA%AecٛܐKZ5ryקZU|7h.Ⱦ܇i{fQ?j/ u=Nr0j є*eYs;ׁXo WT#gq! 2龆%?Dj@j/'9+`jrG}">Fr5} 㟳bLPW9rIJÇ,^իWӫW/gqY8pMM;v,gى_M]̑ɣGطoߧf͚L6Zj1֮]K.cr?kfΜȑ#M ֮];{TV^ݻw%$$0~xbbbx뭷ݻY @ݺu9rIIIk׎ w^HFEE1zh:v'|5 ŋz掎X#^y#{َDDQ49gh *Wm>VZ36FJJ1#mSh4L2{Ѯ];>c9y$7oAL4 {{{|Mn߾޽{ٿAAA8q*&M0h ֯׹eС+Wq]\\S׮]3i>}>'N$　$T;ax=,=Z G<=\qqq=NJ"ʫ7Hw„ЦeCRwSWs~g1FQ 7O._ժ՘U<%l茱,-$Ue{gЅg8r&./2{DQT) uA7K-\fk1F`fF^/0ʆcV]VժR#lFk8}*{0'smk@_AOяD_gdQļX 2 $P  u@NfJ6lȂ x!'Odɒ%:{g}ܹsYf w>m[NgӪUfI={x#GСYcd`Ν;GZ0aE%̜9+2}t)W'|9s رcRLIIa͚52vX4h`XC%$$'OPN|1yWL ԪTb4;{2$9Dv?7%H]hߐU+H8*{$(OEq .ҽMIM:xk"" n5'RLCaH2 Yz+FlW 5D`捆^=Cu0#ÿ$rr`̋YtIODz|bi)A-3iX5d}dd!@"U O$1b[j XFd 24~a90R#?ժk >~՘]KR,K"LN.jU ߀ATQ $Um~Z%:pEV<4?GAeCޛۆ TX~QZ5bbbHLLחZj!+WdӦM[I&ѬY3FI*UDj58::2sL^dѢE:tHgYΝsi+JDEErVZ\zUwΝquͭ4Z~gӆj:f&$j*eG5yl޼2e[Өh6M9sP(ߟnݪS>k.|| @֭9y$|7Vٳ'{S5_~kPpGQ$k;s*H .J$OeOJeZ*x"8t<7Ibś Qӣ6(1Eoڤ\oB$X x&U/ <<:#U?frY8!ccpZO5)pAi WC.m䱼c ժ; P]Kl+0[QdIFfmY.یjkٔ7d*;`V+Z!'doe#@˫ Pne *U͑K@XG#g 1u^_ȯqfKCC13 q4nXgK/.YcРAtЁsrY Fe8;;?ekV"<<~J* o&l޼$ CHĶm8q_5Mc%#^!CXm#SXgFKmҥuiQQ1/SJ[4C3ZrE|R ە'O9p 3l/Pё(A]'Z1I7 &^VYmZ5Ijccw 5)޸e"YҼDVX ,Usʓ~H{2K22k?jͳkgd!4Ej+5nxEgvȥ/ ׀3_e fWG.5/{L5_ 2j}1P_m6n޼i\2 ,fʕl޼@N׮]-v<Ȉ#Tu'}}}6m,mARx8^-kҤ v"&&Xbcc,&>>A₋ ڿ3+WիSR%DQ˦&?^ǔtg.^HHH+WHCPбcG:vȕ+W={E* ʌ3޽{G<vZbbbzn2e4i_ ͛<p~s';)g)or.ΪE&MhԨE^{֭[3w\N<̙3ٷo~YP*UA~f֬Y: v*Ub$/_&$$~1W\\rEGPܹs;wάRRR0i[<<<[׳iLNrh^hԨş\x0|||hР{1*c Iعs''Odz=oߎRoi}ӦM6l*s4#BQٲOc䬪BoԯS]͒e^t䏻Sd:h0KY".aZTz!@ykaj}D5à _Kp)(QTz3R|KY XQ**eb  ժJ 8Qsf'wXYYuV-ǖal"W IDATWoY@41ZUY/4_!C`wl.eǏOٲ;;;ӥKpaaaݻjժ\>m&y-Ǝ#PL,X`U?ٙ7""]tӷJ$BBB8t;K.eݺu>|7oYJk4~VBE fhccc9pԩS =?Xr%իWgtԉC<{,eʔBvTO΃4h:u25hР.\dz믿6͌Px,L>vCoN&ڰ,/PHLJ5r U!=ёV| Y:慏#(E gJeODro)fE%E?g.Н@) l _7wS)Cf;Yb/+/@4N #EǑݐK}قwӨ\A0{CC:f_v1&Nhx4i҄[˜1c_~ >ܤ>$j?yO?rܒ%Kh"ɢ_|ŋ矩YmٳgQ\]]i֬-ZEx{{syƏt;=zŽ;Xp!g̙zٽKͥnݺ n޼9gNvU z`&mɣ_ UgK AKk=pMKh׺ /kj0/JƎ;$@`JF:@GECx [ȥwMP75ڎdBWP+&Qxj)*R)C df f-Cn1eb# Z CM} K9>U,:%{/*࣢$/Uu- J9oTخaZxhk{-oVOȦÃ=z "W^ի8q&Me-Q_#2777ϟoSUI[i&bcciժYbb"cŬ\˗/r];N`` ۷oS>͛77KuҚڵ вeK{=zERR=9d:uRJqpp`޼y36mڄF#Bݛm+c?\Vз+9.ut;;HIzENMID.Ix(5Ĥ)JpJiU+˖OJR9W^șR2|)d2+̈́e@aYd~kTnzZ-}7 r…Jjqv%P2iFJXs^ M/yAExh=CkriUӦMiذO >.\H  壏>bϞ=69^nd7@ɉYfQz;gZud<\Ñ$g2}tܹs~tk<|P 899ѬY3 ܹsMΎj4۷yѵkWO53FbŊ&ƍ?xƎK*_[ƣGtMp&J'e?ݜ)C|d1$F3.vkv=]:d :w1):8]'x;L)r>k31֏'H %­V}(ʢEG"<١ kV)o[,Qzɓ'F%S^=T**̚53؛d+/_絏1cu)sعsU +Νc|8p _/III={իWo3l0V^=IXXs̱Z/ͬY߿?ƍ3YϏ+V0jԨ|eׯѣز: 6ha6U2\SdɵJ/egY=>7Wεw =w4r? נRE !!2SM܈fEqRbj&̢Z5Ro5y/(pd)sQj'U/Rl  -Lι1lI&4h``۷8q"e[NNN|̘1///<ȇ~hl9ٳG[&Ol75w׮]xڿO:Y;w~z}]+tv͇~Hǎf͛|~j- [_~9_¤I9|ww^&M}i@Xn.%=xnH.޿tInR <锴OG 0o}d*2-AB6Z7{~Dj **`Vjd O~ӐZepVժEZU V4dIZ-iiilذhAϞ=ȑ#9v(j9Һuk֬YCǎy!#FfܸqCO(O?5ېZԪU7{F_u+} mBAUZ*˗TRSD HB$Ν;ԩS߿?˖-ɓ̟?ʕ+5 gfÆ |W}ɓcw-L|@PP |_z%Ih\j# )SP3D3%JwaVًjkZ[;@ժƘ0!UAߡ ;DQTskᡡ1B믿 Qחf͚u .0~x̄%7L2vڱ`+ƏOǎ+78qNM>}߿Ucc<}l9fmoQ*x{{ST)oooJ.ͲK9q򤶣GT2g7nlt\QIMM%--X #,,LwTTaccc??prrm۶ww}GvvLpe5 ٧1tѼ<|Fj|m[4iL!/؜(^, B^>Wzv Mݴ KZ! c_5HԸD(Q777*UD˖-uIJJ"<<\/~z ̙3t҅={0~x߿ٳ|PL/^̢E=޽{oiժ#Gu/_>tRڜg1`GjZ:sr6kd;kt%S$J8DBBi(b2tAQepʣj@]*s*<d9eY3)uVI\)?|FI5ithዯOv$UP0 rSͫ v!H/఑KSVa0y @k^۶j^P?MdX":t0$1c ;uꔯ3gdݨT*"""1bA\s?N/}qAٳk:n^ԨQ;;;fϞ#bMʗ/O۶mN: Z<|p@ B䄯NĨQ /a[$Ν;ٹs'kwߥM6QQQ\x7np?~˩]O03f ue{'Np9yhڵkƲi( )&EKy*<@$+q lںOۓfTFILL%̿-vKdMG1t$$Ȃ, IxϵEqڱ"VE(4ǠOOρ]abd2~,Wn>d$ȕUI7m7/`:Q* @rb"|C|'7~K!]vlp6jyyk~V ԌM0`Yֆ d˕+СCM#/zANعs'cȑ(a0Çٽ{qɒ%9sf'OX{{{|||r .]:.]juL___ڶmK۶mbOk.m6M66LΙ3GՋ1cƐիW &88ׯ?y &MD52d42$$~ DQwTңGj֬ɓx/۷#Fкuks۶m[WVVᎢ,R{R޺^o))<~MrF+2b#z &вeKFg`iӦyfݥDʉx,t#@M@$'JKBBݻe3d;hvظ+㥻{64@&sNQ!kVì}@ yO#gB9vw=vFOY7侳>D40 ~l;,AQ˧ _ D&& ULժU ET`8kڈ1P  u&\of8޴xOE:thz)zc\R,O>1+dɒ(JvMϞ=-:)d* kCZZ:ϳjroUL1Vꈴ6?FbR*KfDF?uk 5f-ף 6S;xhaYl"ā7(I/AT(AiZ )T'.Ξe3EZY+~˷K,~>ӗdUGnPɓDjV)4}9/7oJX+ ([n%66ЧO8k,=ɦM[V\|YGtYfmjVXf ;w2/2o@oܸرcyy饗g…8p P*ٓ}RUkpBbbb(YR?Cb->}Jtt4L6ͬۛ0`BBBسg4)m(H1bSxoߦzTPA$%Km6m^z3c _&&&2yd|(%&&bPSL3PCEJ&^p.W*U2˞?Of}U38Np?ХcsȦR|V#>hAFIC>@: B!lmGoLSZsyBBd;vp1e|̛7OapuueرfkY~=;!))I3gHNNq*c BAnq$:uNn)WvJGXt )y* rp(J\|2W 'BBQod D[l1y62͞7k믿r^֬ȑ#0Diڴ)ϞY$DE=W7+H;vZƎ[AZA"2J֭[3m4m_|aZ& fe˖eƌۓZ֖~ze*T`ɒ%ԪU˪q9>#j5of:۴iÀYҟS wg""Xz;]i,+^%=h}|rV^MΝ޾}?ٳg[Az73:ɏ?h}^dU<0M\4Y+1j$&r0$Xo _Uu2sHKװ  1 yP+{Pڙv/UޢZ5TTF,I!~yjvZmIcf팒%?v"!7B0y{z>>>6U/ .Ԗyzz_kmɮ]߿UdеkWƌ ~9 " $$$ILL.˾.!!$찳CTjpww///J*7%K¦%0qD 9p>5Iؽ{7ǎc#ߥZO:'>\qrrb̙̞=|?;iii<|5nooԩS-V|U; ݌oㆵ8rFCgl!Pj _R$$ĸܹp7.?@ÊKpw $h4" ,*{Ă:` Sxhhw`u7i-Z0k֬<;^`JXfͼ͛7uJ2/_n)|\t:ulٲ|ٳR4gJJ l۶;wlS` ;_eϞ=eʔaĈz SL\\\Xt)aaY l,]J,:x 3g >ȥKZղBDAB @HݺKnq#oUrmGW^_⠨JXIF'YQS`kF7nܘSXB@DʥM$~\+J[}DقrҸL|}}8p :tȳ$11~?3IVM}X L*v7v\~T^*7r%Pyk [0?=:?@]_@ܠZL0œGSi -Olٴ֭[[5HYҥK\~~"L֭[ǚ5kr^9&%aV*HըQ{ʕc̘1 8Q<ɓiٲ%F͍%K'֓|i:uӓI&h8^^^VT +>"LQgBVt TȧD=]dᚃ,nZTA6{ 6q/С&N$ԉ;9ܬ%+}EpTTj_XýOQyRlS`sʨe;!@ǤYrS3A۶mc:˚5kƜ9sL;B||TT#99}jAwn8ׯgV;={X|}v6nX ( ^ёƍO˖-M4{t\xzzɓ\Dzﾣm[Km ˜1c,z͕J%+VF ۩*H%8n5˖WGQ#~UԶ)e˘߿p>9)g0K:wʺ PsT(F(W!߲9=O{K2DZ R(.RDx&&Eп61uTn]a3lf3kT*/#{$R"JQ"$U =իW;k ^mEs~opP;Wa@G]1ǿ ;},fY[ l+bnZJ:sy6qqqz2 2Wڿ۷oo tǎٽ[@]j]t1+˸m۶|i98ꕨGzz:vb6 777VJժUX"憫ogggm^ZZ餦NZZDEEcwثFEEqe41ev͒%K,>vΝILL ˌ1%I"00ku|N\]]Ֆf)888G$?~̽{swݻܻw$냰0زe +V[n+.'-Y$}Ga<}j_|]tyf͚`-66֤}Nlr>qBm!m+QS%RH:ՉO$Sosm]RU*bHDrr*I)hsr(aQYjnJLzWP(*vE I HNI"")C㺕)XtK R.})*Rb\ͯ; /O^HKݥ;8(^dFApp0{V>hU68"1)1>óZjhp*5]Ht%VEDIÆ y뭷شɰ*dP{ _\ig<fuQ2n|&z>{9.m/*֭[_:Awl!6mڤm*UZ>}ڤ@-((sZYI||Nc"/!!C 28ܦs˚eɨ)UwZ/ V0I&<4ll}ppɢ@vZ=#֭[ۤZ$%%qA@5QR^XFx'0Ö0US3`TZlZzs6F"APP6CҾ}{Uƈ#8wv1gnn߾m\!/2e%x NXvI f*hv  K.eÆ 3~@$q;ɶ ͦ5mTS,P<'NNN[ǟ@m]BN5>ad..=nܸ?u}6}^i3(ףf[uLqGf`_wYٳFĘlu&7& kw?r~̟?[UTɮ\@رcܷ͞mۖP}yn̙30zJ%|k׮%,,(#'NH]N*-kYf57w1|p7n[ >11 ҳgO6olkȲe߹s}va*UbСZŊ+2mڴBpiM\I *Ah}oM/nsPBP^[{4,`"9ebYO(Ye?ȚJ(/3*{aU y}3Q`l}Zv_^Pi2=EI:vK˖-%KD6m7IW8;;3aJ%bLؼxg՚5k&yLbSl{Q/%ϖΖ=.w `:&2+08sQnjjQĮo\9x6AO (s玦Wf͚T^]oذa0n8.\H ,v]A]Fdsq _|K˖-1bA\4++sIioo|@=L8~8AAA&_Sܿ:֦lٲ-[ۣVr Nɓ\xŋ~zwNLFbܹ,^[JEdd$gϞeV7z*s~~~̜9S%O 7xLq@J]QX{SIGT{G3_ʥjZO\ZtCt q^ Ǯcü>8:B#b]'?n&}%Kн{w6nhd^ %,,L 9r$O\-[X(6WP4@ {M_<1_~Is^ *ktZ?0{ŘlŸj⎘r |7 H i%GN )fjfbVY82\>hjz%,U(]Nbm6j_~ɬK  nI7P1Wipٲe\l^`߰aCƏ@ VVMR1esKx >3J/,ǹsh}iG~mEaE޽Yn}iii,]ݻLlْs*{̍72do.ȭ˞;+RAxgOJgjНP[ĔGBo.=#GmXn'wiU2h ԩw!k?u질O$*k}QTB: r/ ˋ ,&'1. Jze{6.ˁ9u4+fեE&״iS|||pGZ 8ZlYٹ@Rs$` `q@}>j4&Vi_vuLXKP7kל9w+{N<Çkell'Nh&Ɲ:uٓ-ZpU%Ϗrl;wŁԫWI&agkRd̙Fￏ#;\N8Aҥ-R5WeLHHWGHլYs./y{}BCCx񢹷í[|ԪUFddF٬0i>`N@𭍘t75y.ɔv[e ݝHvٳ?~lv$~=,o"!&Y/3kVqNFvښ%^M=X'nNV+{6aE\Ĝ'R)yj{:TGٌmFjV1Q1Qv6mIMMu@tԉA1yd,Y¡CHO&_u啟Ur]\\hӦcGMժU9y$fͲH}J ۼ>Zj1uTׯBg޽F dOSVĉؼyF͍uZߟn:ϥ 22RRy1Ǐ3rH\\ˆ#4upp0s-pn* 9ވ)-7ktz ^ߒTjvz77oΰadϵw>6CHϧ*_Gx%#eUr+g<}q4^:ؓj鷩ؑEVlKs0!PfRCv?`#99d.:::[o;GRl-ʑ#GhӦ@ёiӦ1p@كC )=wYj5kdz{xשT˖-3xiAHHx޷(m ܺu"ڣGشiq&M %''si*T@ժU |E_&%%E󝙙Ʉ 1b 9lҥK5}uaڴi&'{>l ;Xs1)%woVU_-͉ntgzt?aΝv1, &Gp.b6+I!<WnO|MEy47*6o6b*VDxɷċk\FFKs) )p+z5}O#33(=ԨQ^СCIfz+D5ٲe ]sP*:[s45eHbbA#m???NeG2e3Gs 0/^HFFYG.֭Z1{w E}0vn[ä'\*_?-HxT IHΔyzz痳ȡxN >_Dי5q pgtU.j9<=+2kV}Ⱥ{e!GBB?汯/oa|V:u4i+Vdt҅0<(^$''zjvJDDlf(úrJk:!!!ZA{Gxxxi<̋; ;-$͊$?J{njB ³WreVʖWznݺ?O;jKxref3y_ZCj S# Z?PsH-ty;AS)N|a{Q p(5_#KH_QV5!nժNM?@ɒ%ܹ3 |}1I=0IHHHZ2y|9r$/4S+p@[o5vZRk׎9sfݻYׇS4 "Բj*Oܛ7oWM ;;;zܹ3Νctܙ9spj* T*Mj* AAA < 6w;v <<\6MLLd 6LܵSN-\c)$|^ uJ5F*y-hYVZѰqs߃%~!wIg _ z]vRF^(=J72E}'Œ2ˈ7bH5=O Qҥ֢ pv"Qx 3l(٫Yy,7hb"I$\ o`\\;OOOFB@Rq}P* w(_dŊL>///  K&..ά{ fݵk;w/ [nfX._$EI/B.Ɣ=ˠAի?[neΝܹ@ڷoOf '̘1CޞڵkӰaC5j#&2}t3aÉlKIIaرCk;FI&ˌEOɛLK\)s 9Ͽ%"B1yRR gΜ~Dl=-ٿҶEb"kJFlZnOz"ca>Oʯ3c -]Ng`DzQ*84Mw4Mj!1QZRӊ uL{{;T>b:&" D{j`c^);;;ʔ]i;~ζ 9+IڧR٨QݛcL·~k,yr \\\ f޼y7n\9;ł <<<*͏;| ݺuclڴhYx1Z?͂PT[5kh24hЀ R^=[@@ƍ#<<\oѣ>|ˎ;tL7n0qo!(brljKv2bժU  F(APkzǺIxK~YVQ"TL8xYѯEDΨ88["R/7+@NPE iZ ^.ZZMj1Q E@Z"NV}hݺIiܸ139i$SB_z]vd%^Q|q'9bħqX8+ʖV(IU4*yGzӅe&*Pw\)ϲT<./LDL:ק C(hUFB-dgKqs ;h qKɏm=`:&j" D΄ HN1Ŷ9Q@'PsZ)`=Q*~mbhͦ,YR#[ &L`9skrJ)mۖMTX3f_pTbbbzI&i= *PJVJժURWիWwOH455fi߾=wfÆ $$$piN>/mڴm۶O,X@T7k֌QFѣqqq@)4???&LkHXg>UFg\ʂbˡ/~Y,\U૥)bj6[t&QQ 9l9#\QS?aCa(V _ALڦVΆ,Q6ۻC,Q^nفt ӧ9墶86^2ʏI2EHk}uLF" D \XdFcJC!&Rf66QRA[GHFf*-[,4!SL!44իWlPm066m۶|ʕ+guK,?iӦɮ*ŋٿ?7\AE[nq-웟AAAԭ[WRbŊtj%ztЁm۲yfV^Mff&Y~Ν;< 3ΝsWvmƍWl݈#9q&I6mȑ# 0c _fpFxP(Aϭ5\FRY]A%鸋7Irl5ǩ`zʱ~x[(5/:ҽh %qI.[ZI,݃{;Kj\ٻ'Blbjs 1Qn+=V Ec:&" $v`SQJJRc^WniӿbܸqCy!wժU1bL6(d="##MV8tttdĉf Xٳ-[Hk׮C5+Ⱦqg߾}Y-k}tJ'OzO-RG4mڔyqXNBVsa>̛oI~Vݽ{'jShժ!!!)T*L: ? GExRu4A@|p.)blְ ĔFוI+:x,TFRoL&Lef^(ݏ˗5sL|qÆ5;g|'e8L|`Hˌ6r^jm|" d]>HS58j1Z^jVmј4c.^yuyc[ɜ&ʕ+S|ye˖\r[ҳgO*V7|sܯ*bذaTXqW^eܹ:۽=z4oIE{an޼iX5kpyիG-pww7<.]3fpA.\Ur)N>;C߾}eG=IMMEPЮ];kwww',,aÆɖT*I!k$&!@ͭZ# qv(c~c݊E8x*Rx/)~~&*o@nJ;F ~-yi5ZȖ>^F(FuLT`э;lyJwTQn*8[1QJJ\t3F2ߘZr3AWjծ1h ʕ+Gzz::mZZK,17u&KIIa:5bʕ&iǎ#$$ 222?7o~!_}7nZ`ӦMYz5۷*E'0|5ESJ5X`ÇZdza3+G< _E UtrSW̐+{\\xy)12b/y @Y/ި!w͂٘4]`JGJWA: 1 |v DQD%HW[R̖,!-Bc4uL\:^Jnc)I\5& rBQlYǨT*rɖYYY,55RIR4׬YUjfl18::՗VuC\\\/:u>˗/3|pB z,Aff&vo߾ >]K2|p"##uR*m۶ѧO &߲h"Y]Kҷo_*W,͛l߾jWx8A|ZP^^ҋjQNG>%i8H6PSN/M3iD~w,(]QTwYY>;KTTJLLE r=j`s}j@0:&*Xx=?c xHKatQOQWjժٸ}{ժU|qy233PY僦W5t҅jժѰaCDzm(F~ʕ+3}t@2u/_j1go !%KRJTPwww\\\pvvEjj*}dՒؽ{7:t(Tqq/̨Rw^R޳ 5ky]&\dɆ9HO^=JѨv\w~Ă ;v,vhNOY GR?# v!}j.ANfc _uߏ{qq8ft ɹsP˘A5c̤&JAEN>O?d5SrYK``Q>tgw1{l~ٳgXTR΁8p` *G1|oNxx8| Fiӆ#GqF֬YChh( 40֭[ݻ7v2Vrk;wX߽{PKd̪~\n?E  3A]6*Ub|',YsΙ,pƵk/_XXN4lؐ}ZfΜ9|m[fԩKj׮SLѨ2FbժUBa/өS'""">|ѣG|W 4˗/[r{ ###u@333Pfy|+ziqI'%5|>̬_ˊ+HM5MgϞzqqq:$;2/SR} ˸_R8'@|:z-_$=6ȳ?.Fj$L:k(gfGp %jwaKzidM&tdɼ_-ऽ.\*E!*|h 7AI ݤ&_OzQnx1QVpa8cҥKsyP\9Yp!۷ĉ 0aÆqaanWA9ӣFZ(W5k֤r4i҄ӧ8wYӉ5s.J{?(Q͛7gݺutIvaӧ,\>`_g~Yz5}姟~ɓ'0K,r h1~˗裏6]]]ݻNh71?qEÂ./ ԗPѶm[>pƝto!ܙdeԌ(}m oWB=^|p l̫">'ONNN899憧'*U^zfϚ7oUVAPuƜ9s8~hϤIxuރ\nݺExx|^xWdǔ/_o}i?z#G2qD76}l 4~1o<>̄ 4ѡCl"suN8Aݺu+IK} _$/'y'/1d:Ç\pAGclR RNLوڕ /5AaZ1:bŢ8;ٳpr7 Y4~>C%|OŀhMFː(KWb\y!-l >5[-}I[ O>D6ITDr)Dv&MqRRM`1g믿42RTPVZ=ѣG9vֶ͛I*;;;UFTw姟~b۶m$%&rq^{59vׯ/9yWvRkݺ5SL1*ٰasa?~޽Kbb"="))y&v؏" IDAT=z~sDQDFa*U7x *躺{QtiΝ;-վ{}ȑ#ׯȑ# J&Mӧ5?dj*Uhۛ{q5޽ D e\vvvxzzra(汸q-^BIVT(*)z2`˃=OQDeￏ#ϟg.[ڇ/vld|՟}Zq8nNK5@p/~=]TΗɗy%=QzB侁@ikםԧtGr qvk+n=|['I ְF?]ewIX"cƌƍr(I,ub0irJ6@J`R$"O:$`ggGϞ=oe-5АT:G"ףfcLF-ZA {A}\oR]%Ԣȸv0)ruzs* 1-H<3WY ^2)Q WZ*,=FPIyTs꘨u( _nF#ܘ3?~\45kҰh}Æ :ƒ Ipvv&00RJqؿ?+V,RK.fƼ{x{{#.vvv#F;pƴMk3$$fԂd=M{WQmFZe/)$ᱼhfZyBL<AU-kaZ(ϫҎJs\ٛdexvᷫ'Ź˺پ.. u?ǽuO>ÇZmyzGA@[ u_Fg eNɨj=)_5U9r$#GcРAFY˶mLӹsgU{>HOOgر={m۶ LAEOεk5`~;ww߱o>J)=<usdҤ^ſta2e6B3@NLrJ@`s$,^R( ̙ѣG߿URRR8xIc\\\tƝ1cSLرcdddX$sb $sfΜ9AZrr2˗/gϞ=A7ߤM64j>H֭+Wp5nݺůˁnݺ4k֌FQKZXt)ƍ,LMM%,, Qu2o:t+b,...̜93fhV233 c̙FoߞӧOo9uׯ_gɒ%׮];̙xme q$G1@P AAA#I8?XG4\@fP@frQ߅Y؋OW1ydLaS>保@m}^?܀Ĕ,]/ jQ=cp7E@bS($Z|揲V-ݹ1xERD5T-ޣfH26 OkݢE ,Y/saذaWAصkL||W g@f]777fϞ#Rؼy3z(Q^zafϞMӦM j5K,a޼yZoҭ[7ƌÊ+?>o:tI&G}v_-Zo!{/R+V`ҥ&mR(JƍG׮]5r5}ށ3f %K<޺u+G;wߕV ߋiS.Am*jvƎ4Th 7.ND$''ՓSBZlׯ?E'";v0y\0`~cwg6i3f_~,^4Z /ظq#}搕EXX6mw{lPPӧO'44J*q}"##ݻE'''"""d 46zϞ=&N˞kKcpuue̘1Zf͚wߕu@M"QSg!&!o8fjS38uAzoW%ČE} Mx;;;ƏON 9u6-cl5cflYW"2z2j.{h2PFf8)*!hтŋS>GiLz']/]4㡦Vqc|ڣcBB#tE~'&]Fmw$ST*>|X/O@3VpfG-l2elN??zViԨ'N`Ȑ!ܻg$T(Xriٳg̟?ߤ1;vST|O/]֭[]oooO۶mMyrJg̘Jӓ:u\ׯʕ+ر# mpzB=<㏙9s2Ҷm[]v2ѣ5%*( ey$LT#ysElQ"PνJgx#: ~o#7Tc+}V iUjr"ܸWr56[' U`Ҧ7X\2K,Ř#V9 0: fSf2uϴt!^Um-N0U`sJ^ݻS|yŒ!R(k׮|1bI_9rME.P+hX_A?Zo%#{{{JddsR5j4oޜaÆYbg/`|7ٳׯk.\ 4gϞdڵkxb3f:5V\i{#44M9I&8P+>OHsMu[F-LLt. rZG [G} ESpኼCNhР}JOࣾ]$%X>j!h⥏ UKJJٖWV1'PٳgGb AXvvQs Ofر;v fYZmU@r۷ٳgYxq˗gz%EQ'44sAl]Ƃ 15o1///̙Zfʔ)Fe3G%[wV5k~zT*2e 97n`FmܸF\&ݯPN#ɀ%AK#~F%?uo~qv׋9 >TZ\|iڋWo> 5EUP,>&ϲT hy=~_Z 3W *Onme:-A` rZV\ɸqtKqmYKϢ8xoPq _9Z4kիi۶p~\cMx!w"#xEoǯAErTZE s~b̂@``  MxYc"Ŏ drslbQ" D*\yzz6}n㶀JBVwKaggGHHӦMczKCcccK*{|)))j8rV _h<._\'`iܸ1K,ћMMJJbL8>fDQd߾}$&&|bƌ\z(Jwww%]֒(ɮ]طoq kS0uHP8( B1|8u6MMO1f6>賈ZzEB,ۈ14OGڿ_{,{-ee,|؉ddf6k;"wRHAQ4kw@=pbScpc!O ^1cƘ0~ Np-u1sx91rH͛gRIf=fC$>/5齍}eq3g =[~{www'<<R{T^πv*TfJWQP* 4[o1}t+W!*N/_@)&mڴK;<.i -4oޜp3ü\x[C,;;E3ߟEQa~ڴiC`Yʴ&Lм_Ν*EFQ#G:ݐsE{g3">d3}ڿ_HgJ7hV9t ?qlQ YZ1e(> ֭[vZFx.oVlÞT|gQEPPQQQ9Ҥ֛4>H_Nb㬷k) jOA?'8>ͤ߱|B ,, 'xϳNqja" Dt5ww/dM*P3Ξ-XFVV$1Sg4ESܾ}ӧO}|.] iҤ cǎU;aVz0j(֯_heB=A`ذauvv63gδ0!jժ)MKKcK/A`ڴi >\+&Ezt%Z|3;[;\vOgR] ?Gǎ0`cƌgϞԩSǨ*])}izk|}@BAQ'ZZκ{.jj[kk]mmkh݊D='".Pl?b"!ges]^y!~KEuM$ᣏ>¶m0m4894^q[052pV݄%D֭[1k,RC% :t =Ǯ9;qwժPR5d&=wѡ;Iie̙x!mmcyD(5VZ 9;;s1$Y1\ 56qa.͹O#ΟZԺukt,\&퍹s精Ϟ=ìYh'FRaHHH~[݆ 8z(Dڵ qѣq-ܸqXz5MƺOZзo_c7ibXǬE铦B9B٪wP5pǚy*2A91!闀)V.=Z/\F#/jH~:BRA8=+Hнb[pD\bӧޣw( 9r[neM{yq^aMGI <} IDATt?g 0{cKA?}]I°V6#OuCB!j9U B=z@npilݺUƇ BSԥhG@U_F+RpV ]0Ok gl@|qSM83)*"o$ (x >qa5I\.7Ɍ5.SNs,S!i։=U) ̝;\\x'NץcȐ!۷nʙZh(œ9sj{5 ;zٌbP A` 蘒AB YJ΂$a<=r PׄR% ebst6a8EC#X>3,"##jտ%P9S= ݾ)H$:)C0WF6ZqzԆ !!X///6\}iשS:t`=QX?{ ?C+rQ^=r, {#̙MxpQP_d;fPLT8|u:ϣ4_XA*X_ż8D".д&QF!B͒Ŷ)81D4#ZG6PXu};_[[[,Y=cǎe5;KaCyK#Bj8 XCbΝ0ao_(okcM:55k.=EQСBCCpBq:Ga؟X8Ҫ{H-duL;yc梽b~>o:>Ea„ 7n k S % 1iNQ_סWtcAA6LiH !}6o|';ӊ!$$KNNVXw}_|֭[-[`ǎ `L2ݺu3M? ڧ"(,!( #GP/\,5}ӧ59U -n7-مX_te?&OHdΈ(zqPU*X[?UX_Vԧ֝ol@wk3GM#u{G#_Re֍3FXA-;9$ tFYS[*KYu$"/H$ 6 ;wY#ev;}?[jVj28ÖTm۶Xz5~W6Btv]G.'4ƔP_}KwEammŋcذa12@/h"jE1j' :",M(ޞ5Uٳg(..Ku (--œ'O<"??yyyχX,_``A˗/ 2xskx S}Ҥ _T=zVTlj'pQpe#::<nB^^ЪU+xz7}QvmFŔܼyՔ P:u <텚8ϳiܽ-d@L^AFy" ?DÇo߾صkvޭs#7'`n~s@$CL2#htmڴA6mp?zIvGn`ԫeWdʕ!88͚5 X1=󼼼h"m%Ɇ#Ie@HHTF0ZjU:99 5B>|DgDn:_v"H$Bll,|}}rðBrr2d2Q%%ԌjԨ6\P˥ݺu՛ԥBdzF`=z/2n ̙3 ԟWѼys3aaa8pgp͚5u'CII \HE:wHQzP8xIB PDFF|80k,;rk׮E۶my ݽ{WF|KJ='J\ 3dV%'9LNg /v ~-ʹP"c3Z,dУLDg s?\/$.FB2ag(jkAn:㟹kɿҡ@`MAJP@yBv.J}bÆ 8ruxX\sqU%઺[O"00iiiػw/ .FbX|;;mZvv(x{{cժU–-[hcA*?ƠAm,I.H<#eESDf 5`F3g_'PS*ubbb7+;7n ^^^pqq1*077...ZشiSʡ(Ut1il"FP+`{znѢy,5k_>P&ÇP(ANNNSNaÆU?FGK5L8'NĒ%KShcƌڵk!ɰtR,\٘2e oq% x^/YkҔ_X>_UEI7?7X_Y؁ $e0 SZv n Q/bX~k:tЫ}W[ 7}bӦM]b %lI sS>Qz7`Xv-g9ݤ4 -F J %i(\P@y5^LLu5/2Ņs̩'ׯ:; 17FFxO`ooU I+Oݺu//\.#-??s 2e Ln^^^X`Hƞ={p%t邩S 6???]?QJ~~>֬Yٳgndզ>~XGD"ԯ_D" 8;;s֫W 6٪}w}-[F'O")) /^ӧѩS'JzqRf ԘDDU4 f~4)='B+<:C`сw051ֹm@N#9iiiI&gdz>؄ZV .Ű'I%!

BDDsݫ0# 5͗o.pˣף28BOG($%%ig~8gwh9իWqѣ<<<{ԩS ӧ_o ̚5 Xz5kB|r[;wN___k׮F%^|8kդR)ݻwo߾r 8+2ڵ+v}| 5!3;h]<= T^}5'B;M!*HN:e>mPv @-"jLxm*IlH*ZT:pLuфrPϛv-+1F2>u ۱qF 3s v=ZfEL!F6T22]aÆ0alذǏg,)U(1y4bc̾ *Բ@6xB(l!_=TP B 2aI`<+ȃΌBרѻǽF#QgҪU+tw9예+ |WtCdC}JO*|ZGMaڵu`j&bbb`XbѪU+ 4sܹsW^Ett4qJ%^zӧOcԩ:"CڵkqF 0" PqEYp1p@jM.BBBq;v W^:?# X\m0Ķϱnp@:3 6B[T@L'W@FdũSRY 闠zSa11jU p!OGX P r'O".P2GAU=- 8{p"qz EO>ŋacÜi&> 5z2 6$X8n@J@Awo˗/1nbLsh JXؒpRUyxIuNp!W঺9x…\U7&0HsPSK``TDlfΜ xyyӧmUlLoooɓ'Glll@QQ`h# Xz\jnnnżۙ˻j(,,ļy0tPmۖvLǎӧCT"""zi&schh(lllЦM]vhڴiŠb66PG޽o> 2UdK$̘1f,]7oI&aҤI5j80t0dee!33S^!hY;eŹ0B+EtQ{#[1)LI;(i>cJ+xg[k1jes˓HLFt]%ԛ 8[vOҚL\HGn^ W7 _{5.4DedÕĢQn(\*bcMJ??KFVYWȅ%Ʌ=IrE!U ~bڵBhh(<2Y܂KȔ}lbXI,PT]C/Ԙ|X.&YUQBEH?0%(B:u85mfj6o\G=| 4=ג jEvڌ_saPc;6T*1ydxyyvڰ5B!ѲeKR~+W.5S*2@={vvv a=n`` ZjX$''֭[h֬v]sN^瘖]v-zMۛU3=x`۷QQQ6m6mڠcǎ8s ?ÇŽ xOWW@_oöX]+mZބXYeU@s թ!-ҾvX"mkMAB-l/C.$W*B, _{ґ,]V(xc$T4$tCCCtB-ѹ>N><+Z$hS` iD.!Ju_رcpss٥Km;'NhZjj*֯_; VR!&&ƛ///œl߾EEEŚB;ZhSNaʔ)رcqYBetޝ1BJGټ}C^ )/X"V$%J3>ր!0QM`C@Qpw7P8 WOdɊ( @rTi"AjeY. ܒCqX !#|LG4H+j"(p7) N O~)C!{&561 *HH$!Sȧ|0L2K7DwP ל5y +\>7F>1cX{?L}`o<29Qjx(,WgpFxk/LN *L@ m(bX Q{9T*Z#V(6l;;;B=zT䁢-Πv94G'%==nBvx]vܲ\k]V%B*]5P~}!((-Zٳ'-ZWr6FNp)dffb:t(kh(+Ԍi#C@Lr|B̀XG]-D"_U.4@*iB-sSERµ ڨd׻ŖeS =LET!q?C爿 dc,iJPP@.U1(Y%NFp&4Go @ j 9TCQpp0\]]1oOB.\{ȓfͨ55LYb^D.կ:@`9?r CT9 dfŸYb7SB20Ԍĉ֭Ǐlt֯7o6n܈ٳgcpwws#<7berHJNN!^*jSm=zmHسg͛7y3I$ƶW )) wٳ1p@\Ϟ }J8q9rVرhgTcI ȣ|rv4_EaHDgXѫO+RF ,@I=AJ*N<>B_'[Y|Z]&6n-\VLjZ\7d&}}ǯ?"v$UHUߗ<ԦbH>RH:U!,WaԦM,XuxQ1_5Pi5 *E IDATu4VjĘxӤwyo+#_û|ei$LT͛7y^[">Fy͙0((H/hk"\bC!D+XU*v}aڴi#~wv¼y4BT #Gbٸr ԩ.\Xn]ozXXs2%QrG.)Zy֨-E_ -DvZ[p%PRM|r~lN}4L7nbb#)gq>}P(ѯcNJN^I?;}[j9\btFCU3F5;ؑGG c-Շ*cMpV݀\/-[bƌeb}ScMQ`'a U+Wѻ>3ٚhk?&&֭use2Y?j"73CZzd^{չsg۷[n͛1`hN͛7IS*vM^);;[Gl8:Df¤ɓ3BMSgRbb&:u褧BoFBdd`{w!ɐG}e+ iZZT%R= 7gND<Ω}B1(ҪO*ё/FY"'#jLM=`U DC乻p}޿/cH$pssC@@}]t }iӦ!rb0~u_@YT"`KT] 5!pT%*gثW/m{:D@ﰭ#:S,3KzF>jUֽWBTM HP\fE9&&Jy)+ԺuV!a,JA>>H^#bvVVV޽^{{{8y$ zܲ)BCƿ#>>^o{zz:1A#4Fnn.6mڄC<}'.]9sh_Yf( c홤^zh׮Ο?L`ԨQKhr~ȅԊ_/yj̍#f-D& ?S T_H5E wC >ͳ/&Ƨ=PKIIa^an"[Ahԭ[!O#\j*$EzGa?ȧqy)>ae^a\ؑDRmƍ3gЖ eĿгi \YQ % -{fqVy `FE: i=I$=c4IsjQ[j.]d>"5jDD4} Ǵi8kJJJ& qc^Me{jſF^U~Moc2Qkcooӧ#::6m¼y.]m۶9W{{{08QV4|嗨]6zc(¢EбcGL4 Cw}/_۷O>}LQ5nlh}\bʕsDeXV#_Tci/ Υ7$92Xgd&IxQԛJ`yjiXf }g,TEAEdkee&MyhѢZ2I$$ "@AgBޓZXZrWA?ݰm۶h'$@=\Y9J*Ry~&_5ug+5[Ɔ 8ꬺkٳPKOOGllUQ^=\t ӦM3:`Nppp(@ EQ%\wpttܹsyG\\m {ػw/bccѩS'F(aӍXxzzKC1}t,YXlAQkc()QXG1qDkg^LDRS^&4%w} CYǖjEUP Mk,'p#jD()?ǑyZRE ֠@ ! 5ԓUV1{i@kUpry)ammf͚lT$  !B)t hjBCE!@7 u 4c-deOg?Zi;VV ZViR=])g& q-\|Vy{{I&}(CF1:u† ů XΝ;D4QuCĉ5o7nD~E߿?u% |7ד'OM&ѣrm7sd2H :u*mfk)fiik'999XpAfջ g̙|suiyR )HeMoFU?E2J%T ; {-}>~E"&p":w.‘Ö$CJ`CRaOMu Xؓ$HHۨ) ƞ.N6d]No7)**6)0-G&GY10Y dWrj...vзo_ϟ3H$B&MlyyyPMT*eiEƑFW'Op]4i:uBqq1-Z+<1bND"ӱvZ 6 z%((Hݴi&-55.\h[.V׮]6q6w܁J/ATbÆ - )~gV6lt{WUgcvefױye1 %fS+@P5Y92~2ƣ*j%ע"uZPƸb=QǮ\Lؒ8{#`M6YGNToj._"unэ?4rsB Z Y3>V4 fjd^#&LDBRtm4,nnnpssÝ;wtR QFVܻwASZZ5&Lmp1a֭8vmۆ#G߹sG+JKK˗%Ktdk֍߄곻;!4rJZ>Ciժϟ\f zܲΘZv z/.Ywӡȩ g5Ƭt1Xk;@UMtѪ#ͧwsuu3Pv2z _||Q_mFz&S{6oC)d;7g9A*~5 !:s13PcH<5jQTBrBo(m|NWBB1hSLA\ٜ*h߾= &MnBƐ!CX:u 2 3gB!:~ ޵`puui.]y|ݻЫ( ǎM, !D{\sDㄚL&3hӦ ͛]]b^ުOneMˍ'<{25~wHKHH`ٲe+ >D))5k/_x̛7oj[*C)Jܽ{uLfz%i͕~ٶm[̝;WG_ie#EQFf8[}JJ p!"W֫Q{ 1(ϓFҠJ "\S$/ŏK1n֭ڴi~YZN;:We0-50ˏ[_QL |ܯ uj{$x"x]ghx)ըIkVD |eZՠ`("гgOq99941:FUtu(J:t .Dxx8cb9r$8'U/rgϞ{^3`K;B$acN>#F?(JOx)k0]O[XR.eP y75{źuh{TӲKbb"W_}pX/oeBs>ur۷i OҥK݈٬騎{o ~::^UÈ/BiU$D(+Vh3xF_?SBREF*nhZ^A1Bي̷; V [M P:h(fg+A_nvP^H|j)L&CDDs/ը1Wۈnm+Ly[({ˮ-~zl٢'?'j*M>CԩSZFի__\ 4К>bib $%[͞=uAvv6ON;iאCWݻ)`?>zٹs^ۈLگ_?b|jMooo;c6i۷/}P(_!,0E+EuK/ SYڿW\a-7>hLMJ?f(ӧO:ϲ}G2g0E4BMwXFո[q6n8nNE0b]>3XO1 DDD06vAOV G? 0>V"3fJ]]]Ѧ wXիHOOg3p=zxHKӽ\PGMFӧO3P @R :=z 6<'@>lmm9 KKKO?A&A*bɒ%]6_0!3Ӹ[n%jxg_2 Ø1c`kk%Kh'm#:R X׸8v}D'Lct k:.`.JWDm3__(6=n*_5hx j9F2F?sM :z\gȟ:yy@!?zS#!9k-D/mBQHIIܹsK[7p>ܦs X`wz P׹%Ԣ1f:&RSSY{>`5jGQlK`J}$-Жc1;U5Y% :: ! IDATq!۷oowԫk3Ν;]);1v0x0ܼyS@u;wL!!!8gϞaɒ%ԩ˖-i? ^h@ŋ~ddgjZ2p!wi#J:i}N7Dcw#Z&&fH(|:NVBA:{i l|y5`?L}mMi.鏻19;;cmJ ̋rֽ1O`dmm3f=ϔxVJ޶hE|BBr9kO1>}#ً:oy M{oF{/EQqzounoZP88RE/ ZnN]>4KaxYc L@V7!]mV䀎h1ctΞ=W˗EQFݻwXJ%^|={{5k0c |qᙨRq~$?#3g`˗/ѿGR)Oii)ӡR]/5899N:=z!G׮]ѧO;w";;CVVD"3& :lΒl烢(ŧ;ZljRu5<5(F5j WD3FqRR%kbe_(DzMfD'Ndliuݤ4ʜz:qDrdHJ1dZ4r\v 4o?pDyBc%EUo1oy K߲fI T\&7GY t,PGL*(2cHG3f̀1_wLIԵs0R 9`N:BͫA47B(2y%]c๹4/.i5j,Yb<;vT*e3?ƦM矣{6lN~ +V@XXqE\h|t===K.>nڴ6puL0sɓ'1c dgg^kLbJAm۶ܹ'#I|X$''Kk1!6m… DZl_;%?h#G //5jQ^MJ%E_~fy-.`oooÆ FT*- է1#T_V3Uj CGN'qզ >~{bhQM  Q,5PdŘ9s&=qư`"|<} nKyMVTsva^RD,ʟ ÌByGb T*Ų>,}5+ .oO|F ;t ?u1m:00CĄޙjHY1 w7t "C7+5B  n"7fbb"kDA~*F}EQ|'N}vY;Ν3f`ܸq8p Kbl_ZҮ];hFٳSFϞ=5Q"AIHAA[l޼1նm۶_`eޏP,cѢE y]5i$Ԧ]zU;/ʩyo RG̗> `j!qb1KPOOzjJ 3eOlmbYn?xʵ/΃W}&q{HH'AgbPTMVswW]*U>F|N_~z,W'[l_:Z[c;nk0g2[3  ^; @3c\mwG]Ǐ,"M,c٠( bZgj(M0vq;L›TWXؓlOO243*QP K)7j(@`JJ#[2oO?yY3R'.3NRbvQmذ! yvG|6сyԥAs @Ī䭻[8%LZ3[;ۙ^P>exgi@70wi$_/ؑ RҪ_ФA76(iqsNSSSlj@_yEI 5 Lɷk׎׊|hϟѣSӧO͒GGv`oo 9)`wMt )ޢ@SDYdv,A@Elhts~ Mդz99}]3ze .n:T/ܵkҐ5*U Z\v4 ƍccRJ.$k{UfΜ?̌3;!YmU̶TRwN)SB5[&O?gXV-YfaOS3rFEkJ5kX:,^[m)mu_.#&δoY;7^?ls_*V ѳgO#]MJКbpŞ7IZpo9 Қ6m_uƾ>JuicIQ16NYre)BOMVo֭[={]v1~xbc إJbT}߸qcQgAY|YQgAvxU}HVXKIIIfU-ˋsҨQ#e0 sfZJXX̤RqM._XWWW #,e9spQʕ+ԩSQlٲÇ|>S$&&2w\HH{AժUtC1errr OSʪ=}vވyȂ 0rHTIkq f2rfEʕ+tqqQ\l 79f܉RP~W]sPC=|*eoj^78lYfY8zǿ&/fn5[R޵kWi>[vH9Vm#@W  bfS33kcg֭<=+%m]$]Q,+Xp!g.t'3f }̟?kjaÆ4jԈEݞbUk6lժٌ=5j)ԩS- ̍!"ܹ+W&+3QQTɺdƠu֬Z*9l&OΝ;fƌlBZZ)))T2;o< SܺuBLL O<)dS`-0ZlI5(eUFֽ8>(Ti:P+) wrr_|RɑsWm>Cʋ']t];%vmt~ՏqR9Fha/l]z| ٳ'9%e-*>&VHЕ649ML WVӧfrC;wTF$mhW@)]<jAI:2]XjՇ"#ER(_<ٲFz<<<5k~ųYfԭ[ .:/'ex 4`N8kfã`__3yd̤Ihժ{,_ . *oW_}~8ee%Iĉ8RR% ݒjܺu 4g]B +bzSLŋ/_;00ͦM֭>t+K DFFRǦMz}(N)xI7&Vh47eP}j]f˞[jEʁA $%>~ǾA1vŒ+ׯnq[hO?dtۖ$V_*%~‚tgH Eb?wnnn5VZ&?Mv5QLC G= %m/* )(edf3w^Vn:f2yw}TCg1˨c @J (aAg>( !iC ͖j87Gr0`k֬ᥗ^26h }ڡC ` ˼yxvjeJiӆz%$$pEaV]v^nݺ5V"::cǎq!/v֭[ٸq#;w$22Ҫl ˖-:H CpE֭ˢE 4&Mzj-  ,!(ȸ񮽉J*E9{/ kР]T2,JmK_~QRJ5[S06qsw(nwwwg  /*UDՍ>Ĺ[;"虛IlTRL0hFK|/B\r&g/c#E2vD K/V %} IRbsu NDm2G(H+_+Y_ c/:v숏+WtsXCFF'N`|ڥdfX}]e&MT/ѿ#{J֭=@VZÇ3n88p 3Zb?PKMM=ǼyHHNADN:EEQPe˖v9n~dƾ&#/Wΐhd//lk7:4=#6(Z *r4r?EIf۟]kQ ٙcg)!E|_9w~LsSKtih d/^-^ʆE}(_v {uyg!->Ż#xW!בt3}Gl]״iS~\  W զMϟ_?ln Jp$xdˌ_q^ɑL}L43 mtY߬'͘ Nb<>}X:ݻYf>}h޽6g>  >͛7[-oO?ȑ#ر#F~3j[` Ux&L *0k,Νoa-ҦM&M֭[0a>P4H;wcǎ?ٳlْKҥK|j8ϲeˬ~$$$n1dYСCAxI&qݟY9|5m⏞;C 1y ޽ rB,è[pp`ǀ \Xe-n#dv)*qn8BJ]~V q'ג|#F(Ȕlo#t~G(a`''GϨYkoa'eP(]OfﶭM wr>Ϩ5'Ii$$jqzXL=p 4#˘@w$&d6(2r;yw? 4~Z'gggKHHC㾸z lQܹs\B Slu΢`ƍWYBrwS(}|2j/ }&bbnR9$iʈA1Hs} 4rlUEF^EJ*oX4غukm~~~tޝ˗ի1B,:tr{=}ɋ/Ϝ9sXpaK!o#HMMɉ,._ŋ ًS~} ÇٳgO.^`` 7~La...dff"b޽l޼AI&*Uweɒ%.KLLT ݻgQɣ89;}4mڔƍ[4.[8r>}]m6xzjݺud)⇱";>eN.ׯ&a돃nl}5[ϤFҥo oi`SR ]GF0RD 5kfqB*+6eA#* ^mƠSNj d)Tˋ` Y9;^s|*jysܺǡdi)N@^%Yf͖]ר"eDvL K6]i['d."RiO6y֍xfy(#8xLѳ7m2koذ!Æ 3U\ ږy8 m\ʏÇ7L߿<$mh"D4$mhk/}gE)1TC8v@绳w^4m>]v/111ڵ={RLt!ϟǏ)_95k˗/W JXX7rH\\\X|^s vD#(>ͻϱglْq $:#WImɖ=ф_Z:u>|}rbb l'dOxz-EeW)i'׫M ԭ[ݦ"ͤ|t| ^ۇ~ݻ~#r6yԯY,ɡ>iַ2r4W6.Pؙۏvf͠ʥiDV3%f3I錚̧scXDʖ.I vԬg>NcŃc"x{3p ^uu 7^(˺E+кQ5>~]A!!1udoǬh׮C 1&_vZ7?LL ݆'q>%U{W46 :hG#H5PL:vȖ-ܣ<͛&m\\\ׯ!!!dggfFiXbbb?>7(ҥKS(#/d4o]`„ K/D*OmVd^˗  22UϮJYRBEϯP0#IĐiHKOowww7jD҂*VH\\ׯgǎdg' IDATgӸqc:t@ƍm F@Ah߾(^[rr2_}AmjӦNחiӦ1h ̙3I&4VSqi&N(tܙ%K` fձ ;ApXfJW?d*nPFYۺuk֯__ N]Mc ʜpqs=[˔)ɓ J$Jw B<<+)SƨRirj‰[d#%55ܼ0I޲62r8B}Е8tM/ɨQi*5eLAxI::=&L`1ga!|'ܹӤ,ˬ^Ǜx׍jk[vcOؠ#ԩS Ȧ"F!$xW36ߍg \ɓmKwt6@Eb[cСef&1q9'Oyw5k{1<OJZE0Dž3w,&|K2G_tA0M l%mz*r=#3[(ҦM>j9ȗq-) NG/^?2itlWH%.?we7GXKL.]zeJo"PT@qأʨ1U@ @ w3fpA>s6n܈F[7@$''G 'I'OҥK>%*T`ڴiaQVCVeJرci޼9ů!++PcVI* 7,Pಅ<Sj{#G42)!_:|r\eoJ*U$K_Ƨo:ɢ |ơ˦.;\(k۶T?ŻLfÔ8t"N~6 #E'DE UT_~Xpuu%88uVꫯ_߸(DG.8dLiYLa7]/(HR oCSDF_((7mq:D% Qռ;^ohL"ҩb 2rdD$%56)F?Juy"G1˃4w 69Lt/92 qs\]eR~ӿz = iCgJЏ$mhFz M26U LwfNU^,sѴnݺ)f!˲I.K=@wEFF[k׮SNFK\A~ٳ-kԨAŬjժePu dB||<'O,TR=z4%J`ԨQ۷PjCx-.xG)n {tG/F1V$?ӖUa^ uOyկ_?:%?ʟA0,HZFZe\RJWu$&)*1coݮ&2肵f|ӧث޽;k֬wBZʹcRQ63+o9ۉK]Zz뷟ϖc5mڔEQtB*[I}Dgv#iCZӺq5 8q~VөS'֭[ȑ#4d%_:벂EIE[Nul{_my|tkdAjׯQPH |ry+˲Nr.C5:+@ M%m IzH҆@Q{~&8q?E@#2g(7߃nۺukjժￓCJJJ 9r$111@^:t^hq[l7ߴٙ о}{իgӧ(ȫJBB׮)O$qj׮mRQQqFZlI޽-Vsq-@mC5@e&QZ[ZXoooΝk \r/_0233)_t x>tNѵTΔ>uu?;'+e 7oN>}1bM6G$m|+Pta[)8ws P&ˤғ4]ǟGvIΎ}o([L2m*ZI_:|ifOVۭ݅$ t€ՉV*KF@IP (EgPTRrܙYʇ`N"^dVFFFݻw'>~̝;,X-[EիW냋;w2w\oQ\e4G͚5=ztHdYfܹرc899O?H~Z-]Z5/^lupCu ҿg 999 6/C;A5k7N"$$>O?#~J߾}i۶-ݻw7=''޽{s]iԨL?OȖ>H wdYoї+VQV*zBL\n<<ݝiӦ)ʏ𑯘 'r_ӹEvv6/^ԩS^~4Qxyo1A6#`-`Q•X'>mcxH lA- *k+[laǏM6&IHHgϞoW_l2V^ߧbŊX.^hׯ_g 8"gIZXpUeS>_M26mbѢEhs9;Cjj* yfxϤw[A'|b󤦦Vƍ׏ 63uqqa񄄄f<Xj*8Vtʒ_Sz7c1tb@fϞ7v"iI%y"T%##O>X=vLޑwIbt`ENW`$MF#!%4hEǶ̙3Xe<[dNP44}N>TIJJߒDTZuRZ|Y,Td!*M(MPX*>>ɓ's9_WexE P Iel"np9"hE1֭=zЗd']0VH^G4HF1ryVҥKnP`-y5jЋUV䢧4Qaz{}EFN3 1H3Z҆d%+;Cs}}.j~[ܗj#I ܲAj"##X咝M߾}iJj*ŔrVbj:w̯VTIqo΂ X`Yug͎; AR1i$5kf#$$qƙ 1i$8{ʕf=Ӕo8~8'Ntō7;vQIr%4iԩSL /&**S/55>Ȫ޸u2$"H3gbC$|C4߬5ؗ?qPҬ{adT<#Ğ={>}Ԯ@ /MT.i J\\\0`'W9կ!Ċy$&&2vXEi,_gРAFaD2s-Sf, 2"Bi"S(i4h3H&rjRB$llTdl*fBH%$I믿)g ЪU+>sJ5JP( .fsѩ8445Ւ6CtUF%eތ]XdtUeE CPgjk׮ ?Rdɒ7___UfVtPW)>eI[y}sB 9*Uйsgڵkg⨫KI:b3Gductہ_oV $iH_<0#3ќ毼a$ ]}pA "ki6^OիW4h[npHOOO>1Yޱi&|}g9yd駟)*ǎcҤI6 P@n6P,H^O`vvEPctY9IpÆ .3tPe0MU2Fݺu1cES={xRSSҥ &MW> 1yd Ȩ"gP?0RKA׋z1HS:7Xی(rtꐋIE??BBCƙ$E~,8 Iqk ЬY3>#^~YYA5?N$%_/!kIIͤAG E]ȴ]yYO 8DP_pz|y~;w ՕW_}mڴaĈv })S$p7￷9eӫW/km"ILL424kXf Ǐ:H9sůOnݺ4j-Ȯ](SEA{g˔)cqV\G[|WXo?_GZ}ewA~5-[ѣG# 2>"yQHi,$XZO>,^h)[FQ.n#3&L`6cT*w[]|i18|r>esH+_[|W9nA 3xʷ|͚5_~'V^y,Y´i 4l嫹eΒ6wtr i%_wXvQM}|KJGΈ ?'H׽93Fw#0rnK*UЭ[7֮]˔)S^UdPBKts4]g,݂g9;^Pj"#DjdWz͑#GL.dgg`fϞ_e` /P\9߲www&LK=<.XQWΒ%K ĉiذ!C )T_w/IRRo&>>=yyiZBz1ců-Ϩ T**] 26m2* Djը^:Wz>CBEr?dTӹsgYۨB)*3`fɚCfҥK3gJ+KِH&nr B\]]1ccƌ1k [o߾͒r$}, Nwҕ:>7]*ǒ$P3 dݻ%K u֥O>FGxɑv L064A%mnVSVK .jO$/$T{+ r:*PtNWڷo+4ٳkr}*(TZz/SN*2qcp)?wFM*4&Gg[|l\~3F/0Y7i|>}>}йsgcRRG'Eͨ/'O7v˲Ν;ILN=٪ -;;YfQvaшrQMvΝ;T\l;Vjh)UDptN:qFe]Ig ]mH-+ܻv:l8±͐K.ͼy(_ ?]<令Jݻ0}t[NO>gr1._:GjJL /TJԪUƍAp >RpHWDAP4*۵kGƍپ};ׯ_yiٲ%Z2ڳ"rD$*$S҆ L!T i&"# i4!)kqGRѡC:t@TTW\ʕ+DDDJff&dggSdI  ^z:uX"R1lS8bfOnRUaB܋TwBe`o&)UVBVb |27n0OVM͙2e# o8@=wǏgܹϽH;wd…E6NgƲdV/b Lk֬Eˈ޽3f:Qe˖ٜ~:=~.(]t!%RRR?~KͱU_XTi :AmS1504v] /_jeX{ FMTPLL +V 22SN),˄qyE_qFN8AHHM6%###F7߰`^7o6#$$ĢR6%bccCڷoÇ ѣGdffEVV>%y~-^_Zv5_ t19:`_,LNtMU{*(!ߡ|\rd %ƍJ*ѫW/$c3juiH&Nr jRp"CF r+E΢9yb&V҆~B5iJx"%W4+qD4Y/Vt'/=ԨjO Tb4 U0H4c%mtl[Z# 9fW,Ψ܋A.ϟgذa&K EQ49QvsscܹDEE1eʗ/ҥK7ǣGX~=ݻwۂ+hh"JrÅ  Ν;4ocrJ֮]kAMF&M~,˴kN4k֌"g̙ڵ ˳b T8E, RPTڵ$3M4aڴi6?1/LppŏwEٷƍ,s*$ O˜6lͥ\Jtԉ㯺&E%E(C-EI97C_ '>gsK/'ҁOt"=(ȈdA !N-@_n'&Mr/i JЊ@8Px-ifH+Rl eH*ecZ@zТ[ndkemFT'iBM$iC;*#iڵ**_mtҳ^zfULyիWm۶mۖ{]# !Ci͚5 Y9r$O׏D$v~ʗ_~o/-T*>3͛Wc1fݻ- :-- gZTݻw?lݺ>I&rrr,6r 6mݭ[7O޽{tj] +W~;wuh&7j ]Bkɜ9sE'ݝ'2 b <͗Z|Rb +ZCtX'iA(`N$&?]=RB| /&^uJq&_3-@&0PaOs4$mh\u@77|x2r4 JKG񖵸ʏds$y@|*W5IEڿyO9U++Ln.H4-x)+/yp[2c?}߿M |eC% 6܄o-J#>>QFY%npϜ9scǎZɓ'S}Vԩòeˬ. T"<<3fйsg.\hٳ||(c/ܽVe|G̟?7͋JF,_Qo aek֬iT=MLW 8O˗wH&9] Jaɒ%;w.ڵPŅN:|rjYtx7ɸ1H'))G>2r$)z=T'鰒S6?b&hvq03_}/Q :]D5 4$m`R~GWn4yQᔑ)-|w9O&cxKWqbE>:q'g'C?̓4,Y Ҝ8Z@emJǑ@0҉lxf< ҵkB}1...ԨQ={p1ڶmk5Pvm6nȥKh׮ ̟? cڷoό3h۶-^^hٲ%ժUv fffrmӧQTPp߾}8qI ֭kV1@Ŋ| ej322سgsaŊDDDj.](dddp9*UDM>v͚5߯jLbߔJbټkF}Oxx8_|M޽{M v ͜4$ѲeKZnMBBo[qM7nZ6{4^uSl-.ģ"ljQ~,SEeKDD}EQI&9h0TT)9|0ϟ} ҥKSre~Wn߾M˖-yg7+WPre&MDΝ"a+{QL"""ʝBLL aaal۶8<==%##*lJoRzu}:W^eʕF˲СCpAXZ5,YbSг~&OLm))) 0~枷;w(gϞh4-2jbzdQU~| ppB‰ g@YNKMU)@҆N&눬1R:<_,ŲF95 OGǐ/>)ioHMl IzxY`P(?1HЖJPR{ 44ю~"3j^ى?>rqrraÆٳ:&&Y&Mp%NPk ~ vqg2v8t4@vĦH]Ͼ. c&%RŴ-Mrr2C ͛|Fqqq̘1SN1tP" I|.]Sɐ$_~EoܠAƍgd=?׮]?6dh4&ڏ?fժUkf 榿ERRIII+Lu2p@^zA7DKHH 88$DQd̙J*֬YҥK wފRkҥ Ǟx7-)3HPEKQJ6 3$?E4T 2Q҆v)NT./ZrR95ZW[)'FJ4;!iC`G>3$]^////4,ɛ={p|vQݬR ۶m#<k̔j%###W@gF@.]5jG _dɒ͛Wdֹ V+kW;cO{Փf:RtUI:dL"eH+llE\;J,(Ѹu(Ɋޓ߫ B?js R4&T#m'ʐgIV 4sUM&r>HK 0\!uFtgRpp>lﯧ98PBdɒ8}axF2xV)\Ψex j]EcǎB?N͚5-WmڴalٲL>3^Jj՘1cG{mrh֬zVXARR3fp=Sh.Wiiiر 0 NɿC$j֬??^\ORI^z <˭AN?1==cǒ=CDDGcjժʕ+Z wrvӦMviuaذa)BJeZe) ^$]#X(b+0qĹ5J!sVzlfmOU.D.u=ӇuVR& y!MA/k2bp Ӈ(7Ӈ_Z.#n`$+?eAw[\/Q?SAD"+t$+xӁq0+^7Z ~^& 1=$u/eoղNpsBޝ` deI#5Xy*0ٳgy cʔ)9߹s4hPv̙3=eǏ3dnܸA&M:u]+Ob k}]5kIIIt EQ\l/Ga"##=& *T#dR UwxԺ0< 1k.ƍWHpp0~icԨQ٪{fݯ=.]믿bFUU:u䵒Ge˖?0y쾼+W駟E`` ={'t.iii:trA:Ӟ6G(W{/;vh=Ο?/L@@s̡vm8]9s~1|pǎˮ]oѢSNuwСv7 tdej2C44,C _#J4J& > e"ۚ{n}%YYVd(np_]bAd\OǓ/:) :]pF uժ˱DV9ײ鈋HzHKt@5E?ݙK#E3&ckM(DPI$+'UE "I2'mA.:`$+vKTpdȦ9g{.a+4}b) &cy'/ʇNQ<Ěos<2Y,\o1!!!̞=;^Ν^-[FMNSMNN7ɓ<ۀxMtckSBVX5k:u]O[cXߟ.]x-'b69p@vv$FÆ iԨ 6;͋53uT5kƏ?':oϴqFL$IF3wγpW d3db8 6+%Yٛwn)C4z=JC5~`VDIZr3U4 *qcv{Tя[.C%a%Y񸤫j2މx?zznN">O=(T 3rRy7B)0ubo%YgdxDj"L^dej2LGܰZ仜cֶ{qQ2>ߜ~V>ȗ,<Ax/-dj2qD WZ5̙Chhhɼ>}:~_~gϲ{nzR'))QFq@,^aqD.\ȪUȠYf<<s)/^MJJ޲x@-oܸ˗/JŊ9qݺu^lٲ/_epO8tP@q1ēO>ɜ9sh#سgO,Z*UxpV R/IIٛ&L`7pgF8@.mwE7dÅb@yM, D̺`2;x(?-5&c3D)ٝjWgqIg}tE1 $+No{UsRJ+hqiѢ'$$_ѡCX`?s115jкuk_QU?~AȆPvmmFZV8q"_v.00-[ҩS']Ftt4 7o&##ڵkHll,C iӦn3;J*qSn]5jD-hѢb2cΜ9OPn]}VX ,`ż2{@&M:gڵ,_s}[,Nۥx$+j2VEJ6CżNV5:}x`MOZ.Bd:vƚNTdt^yu |5ȉP qy;ǘAPr Ӈ_Z~ȴ✭Aḱ)mz :})e@S.{xD6ߺ_"~\|38[Z8+xd87_2>ܩjٻQʘFd%y6OAuT>|ղẃVާeHD#{J_溘hF-Xy5>@':HU-ZO3z|B$=\ΝcС\tU*'Of֭ 6nݺ9tj ^{5RRR ?g 5kְf^J`` :tq˛S>| ^쑑iزe :/2tPΟ? /@XV&OLddSAZN qԩSdddK&MF]fA{ksѣGc6i߾=cƌqjyf|Mr"**w}RZ5x uFŊ};RL~b ˑ#Gx<?~2x`z)cmFDDD{/}GKIJT< Vc\:pݎ`S\Ookf䛍N*z`~z"J\%ѧQ±I܋z䗗F0C 苰;Rȸ̼ r D&c#D&T] L[/J8U%YvcŊj26Fj=g{5X+`V ,[,+W,4JII!""? ^/t^ʔ)SشiS̥KxWv5իWvZ UVnݚgASׯ/;/°Z,YyΘ1c=q]v~|D7lؐl2=R|y͛i=JղW@]>$+z{[_# ߓC87|JUj?ʙ!z ׹!+zZiذej!&ݶ̍uZK6&ayBdw]%S F5?UTM0cc_l6Q_Q dbC.03xyZjń @U"wҥ Ypp0'Of֬Y^EQ7n\ViӦi& MUU~'\vJ*1vXz= o߾DFFzjBѰaCڴiC֭U˥ѲeK^xnϹr SL!&&&/ b&AAArQN8Aݺu7n 40nUL[vxT1/TIOߍC铲ڵks߷GÆ iٲet:?իWgǎlܸ 5jkjeƌ_>}K/:%55[Rn]ׯgٲeP̩Gz޽;ݺuoVZEdd$/^$00PUVp͛73vXRRR2e ۷/AZќ?PfM"##9uqqq׹sg)yp2) ,BVލ@&$+Feo=~ETmZuIkSk)Th^__A^PZE< 3~gf̘QYqqq׏dz)yiii۷]vk׮쀠bŊhт P^=-KqqqL>=ny[ y>3V^ LqQ;5jh4zH?ri>)8OW&c:Z7u21y7pEOqet|It5:pD3 1 (>U&!󲧀uxArIV=w{a] 8ɨĚP˼Xp!|MQf?>}aaa̝;١OU]n| AAA|W.!55ӧOsIN:o|l@@!!!TT:vqixW`͚5,\t}Yz"(@bb"O<$auKj*ΟwTlsaRz@ t{Gq >3nBOUKTŽnT0bWY*D0Wi'P>"Xp~x.1ޓx;!B9Nޕde9*fHbUM'4>ԫihj2GX0`S6c` ӧ!2em|3 ԕd} dl(}8I }(N|Vf0,5%}!%%~qs!--Z/C1n8i~- ,vڼ=Y2dǂ4@n;BBB'O̙3Ǔ@bb" \Rl^[ ٸq#W&!!={ҫW/2 "*/wegW[7DGnzVA T4 m@.d_d |Nɑ fIVΪ&cBj۬'UKJN> zG"Jc¯n 9j2~Ps*q0@m$+ssQ5GE,XH-H"Qd܍LY7H1Qulsl9~тd0"SٓR#ODI|'&7hIV|Lr_M FUHŋ cZ;w.W^W_uHbҥG~۳=4&LuiӦL6mڵW"$$f͚ѬYq+ TU%&&kײsN*UDΝyꩧ\vmٳg)SƩʕcܸqQ Szy:mEP&ySŦDV,H7j2A>~|)!IV$yB|?#.bsͳ$+97|Wƺ $Y \E:L2yN~oRr2^hh] IVTd셨ɹ_SMƏ%YIdej2n'wi;ރ9$YQ__Tq[@E"IVE%Y܆TV#=+IociY#Ng޻Q;;i$K HQqoBCBU$Yz >vzd%`iؐd$+%YȒA[P"Q[kMzA*U 4شiL8n*G,MRF ZhSO=Ufvٳ'2`qjԨᶡsؽ{7'{% ￟ÇӢE r pQ^~euL&S:9ԩ:tpk]?RƟOjGS#O;C $+ޘlGBHA>tg'I9BRD{3ą۪BM55-.~:%IVEۯGn&m ɸa RK 'n{rүf,IRe1c뛚g{?NqrnAEȏ9G s~N23U9HJ_)YYۅ|U9UIV۾񙩕=jHx cu?n>I&̚5#GbX [o1m4z=[lt:ڷo}1i$TUTF >*Uxe[J~(_UېbɶrʴlْW_}f͚fVhfEr4i[b8AKT=|IJ">(rdcBIHސdej2Np ׀Ƀ{t "H^% gNdj2!GW¹dE3pIVf&3ײ=" >sIR}%%l¾OcĈ?^:'Of\z5sua޼y[zz:C ѣt҅Q\QuL}Y*Ty(i$$$m6"##9vM6e˖h£*㏓D۶my=>bb"/rL:&MVцt3:Xc׹n}҈j2> %J''VMF=pUg>JXp;i/򦆆l de̶Fa[k6O$OIJJb̘1:tqe˖%999 ֮]f]+|jԨh?;0a1Zz믿r7oNiݺWza̘1DGGի\L:M68F$"""xZ+zj<װj:*}< >HON>}x饗رc:tয়~bҤItAٳ眧aÆ~ ”;"" D9A@y ~X屇Qӱ^ mвi )WveтVR9DW(q80\<iJKZaCj ]l@&MČ3X29ңYdfΜu޽iܸ/8bbbꫯFjj*FӼysϏl6z?VZ1l07nwxݞ'+P!`ӢE LMMe„ ].ÀxG^O"@k|XNkEH:%T=$YW#j%$+FJ:d&ĝF*>s!Jj2v~>'7v44X50p<8!IzΡsmFΝ<*[^zcsŋСW͗HKKsnΝp Nb͚5,]ɓ'ӿBCCxWǏv=y&(((;hpNw$$$ouؑ_up2s!Uх4T ߊAZDSNGpDpDdIބIV"YWM;|%RNl _:ubΜ9XoذU`dۗڵ]O?9cIDATeƍ9桸`:wUn*U0p@WwNϞ=i׮ 6bԩ>ͦ/Fnzfڵ˥9, oǏ/t\V5j' 329IFGwCHB בp %YD|K6みqO$Y$+I@?h@qse} kޮhrJLf0\;Nŀ``ܹEYgff2sLNpP,ᇜٔn9 4ӻwo~Po^ͭr VO=t\%gV=<ȫʙ3g װaC"""

`Xhvۿ8$t*ʀ]y^+]$+J)OYx&s1{K obY$+jhhxIVN }L ϛIH ݻwG/bısNjժC>,* 3Kw"'Np%K0t"rwG9T _lĿBr\G]٥?"~K25#J$+#/ph=$YXL[Agi544ƖYk~75Dj6><&:}G+˙3g4h-r,.55>HsNڴi÷~K˖-Yhzb"0?=&,K9BZ zŒ@ZjTXYĂ=_΄ /IQӦM+I 9#2_󥰮ue$+b:0AQ$+HR"JIV Jeᛒ%C5B}l$+G}F$YIde ЃٵkиI x/UV̝;z:.##y1dΝ+pذalݺ`,YR+2a""" bŊxh F$+ B1 ~ޓ xDʟ郵444DU>>;+rjRJH]_~UU%==S|y{/۶ow#""fyK荨د,P/$=X-Jۻdej26GM5"תɸ!3~G\#qF ESqAtQ"50au<q1Rb`ԨQs=̚5ERRR>}:;wdĈT\ׯ3e͛sEQ|yOnxWHKKiӦψ IV%2Bhd=&IV\S(є@Pgqo$/ݻw^zL81߫ v+СC~:;cǎت].]JHH~)K.e߿smѳgO}Qʕ+Z7nK.M#P^<Dajѻwo  9vJGdu+ -NU\Zd<[5qIVKpIVN"TLQMF hڪvOcZ@BUR5 Ž{$$$0}t_Z+Wf*yÇ3x`}|A@[.; k׮у0ڲe 歷ƌCtt4sɥM9 AOh޼GViǼ1dw=a%𴭇0"Q̼4򡚌;ݜjNCCCCCC)m@)#$$>!²o.\쒑'|BӦM4}jݻw/h4ңGʔ)Ê+۷/cƌ!&ƹ 55sz%p0D/3jy=<=n6̙ mAϨ%Oi^G}",mJ|f0$]cE-.ڴi xꩧ\.9E?p\u2d/_رc{wޡW^̚5={ڟ"CXF ԩpUE/%*NfeOnpҬu|W}nL@0Q7S%Vfn ! *X#W)95k[(ǎcN_2l0:u}9s裏o;unll,7n$***[0886mвeK*W=ݛ{;زeG "##-[uֹ5grr2cʕ{(IЫW/o~_3N9qNm4'qhj2N$+% ')b"35 b/w͗_~O?Ζ~zj{+8}~XX( Ν#::]vMTT$Q~}xxc=JɓPEp ϦFV\ҹիWvz$AZ<"y9XLp}G4444444|F{TINh0,t:6lHǎ9{=H b0<*>c i֬[sUP ЩS'~iׯOpp0GeΝYQ|y.]ĕ+WtxDڵfWN=\#==ݩ :,,Gy|8 t<Ӽq. {<=0 |DӇj콌M("NihhhhhJUcNb2^!**s:zyw -[3{C.]XOKKZjn?8}4O>$*UUVjuS !!HJJڵkԬYӡcccg(>^~?ʖ-9w+qT֬YÒ%K0Nm۶ 0e;'Xa8PPl}k_M;9 D ?bfDW$ŋsѹsg oZ={vLP>}hР^=.] ˣ-/!!!.grңIbbSi_c|,_nfrr2VbٲeNgZh(ȲO=| 3XFclϋp$YICz(@ k6^OAK?~/OTTT^md2o>ʗ/OӦMÇ_vm߰ax6,33@﬽L6sBڵkX~$|5jĀ易`PuiI 7e, _bF;oyKER~}fΜΝ;Yp!G-dVXʕ+i޼9=zUVl޼.yNVZz ,YVZyMdm4wyS:u*{ (GBB-W6m\rn:~g_ޚ6mJ^rzR8 |~na[.P3ѱf';uִnݚ={pB2lV={g*W̕+u 7o^x"۶m /{tRNbYde@|O._SbŊN'00;ңGԩԹnL s-V-ef0\lwwdѢEH奠 M/zrX`AԼߟWfMvlٲ%ױ7nI잓Ύ; W$TUҥKZjу{ *}8f0دtk,rl&`.u7nܘ)S`2Xh;v(Rt,1˚5kreʕ+5@!fQJ,KYŒ ,Y¡C zܸqiӦQjU5j/.QUOJ5i҄z6mx}(L `]Z9MHDCCCCCCCcZkW}t+8˙3g_Gʕi׮<5B8fN3@6ny/sM'Ҿ}Bٽ{7#G,rGQRcot:dA?Ɯl {p}y,b@O Բ5"(8KBB7ndڵƺ4Ghh(=-ZI&4ύ7֭[vc֭]0\BϞ=s_dĈqC=o7w\Ttw}tܙmPPW9_y9'w!nz{x 4 Q@XI`2]1s=dz>˾}ٱcq%/_{y4oޜ;aÆ ]vNGȩеk"{v(P[~= ,= jբK.tؑU4"  oCwtS\\$1rH:w챵}]e>c ?s9N<ɯH^@L? +8F(0xT,/aC Ԋ l Ayʓʁؾ};۷obxm-NGHHUVjժRjUz=AAA}י:u*qqq?TZ5;0;<ɞm*S 5M6<ԨQã L36{y"zKZ0fsoy;naZ9|0111۷C$+!I,ӴiS5kFƍ .me=sM9XZKzjhhhhhhhhC Ԝ&<xARGZZb۷#G8 Y$zѬY36mJƍ)[lqo+'ga!PrsD Gh4 ׌/~?ɓ'tRqoeUV.1{fVDY$=`(_ǁ8 vA Guile-SSH Logo image/svg+xml Guile-SSH Logo 2015-11-25 Artyom V. Poptsov <poptsov.artyom@gmail.com> GNU Guile Scheme SSH Secure Shell Logo Lisp guile-ssh-0.18.0/doc/logo.png000066400000000000000000002474461471416131000157320ustar00rootroot00000000000000PNG  IHDRB'sBIT|d pHYs99|tEXtSoftwarewww.inkscape.org<tEXtTitleGuile-SSH Logo23tEXtAuthorArtyom V. Poptsov ROtEXtCreation Time2015-11-25R3oRtEXtCopyrightCC Attribution-ShareAlike http://creativecommons.org/licenses/by-sa/3.0/^Z IDATxy|Td7 @DYdqmݗG}^OSVjkQAT(@'+̽?BL23f& 59s!~~%UUgٽm}UH *Rq@P$HKtI@ x iK635r "PьFP^n;B0n2+׋$޹/!Z@&2QFyseܻ4VӅch <ϼPU_4׍Q5/7^_!DK \Ķ,"Ve%Rfw#PΗq|8^h] â|@yyeJP[Ы1G%` DF:R-#9׫ !Be[@$UU9~2ä~PxZ߰%|ٲ_.08wL~Qhcx*h%&v4\VqW3Ug/kv-BAlf6;}߅KɲV1ܧX?#Uf-?s'^*OqYEkf$O$}-@|G*!BV<>>S܌,H, N|0E3i&*o=i&K Kh_#DK )[r#IȌڲ}Ӿ7̙ʜ4iN{o:&sQ^;:qq.&mbPmr޿&6kxX0`%~>fI{K,y.5}ƧyjU%a_ccF7yкcQK+(&=#ʪ}Et,o|21:0*2gh8f6t+nPs ,,Nץ=( }.0kݔ\p/0{\PY d!LϠplR+79q*ʪZclڰQPge[Vm΢dKOr+;qUUסj9bȄ5180}_L \|g>pGﰟܲt.~7Ȓ8JneA~Puyj@# 'TZl/@Rn2C{-@QvFkXM͜=oTD(7Kqn (П{X sٴ_*}a7>TW@=>W 9S+l"[^"DK xʯAJ8uF`tګ#,jVZVŎ:5Y׳eh%wR': rAns@@ _2G_~8ww(G]bfj̰i;zfU|?w?؀d'$qҹh4%i? h ,*ʻ\K_0wcO`jrM{]:MXoѐxEcfF;_? "i'3珜 BGWS!{QIr#q#;SyS ~o؉.ƥf/JdɈ21·R%IsT p~Ch ,ިW E ZbŒ6mlq]򌾘dȈ5$0cPd:9 .eBWbڶ9F  6Ikj9d'XT +d 93S&mz}}!DK o`U\б=ltSJil#Tk&Yȡ {qMh %@&ƍvDk̨|};`6vPm v5aqIY$]B[URa v ZFMf3yW)&/jWym%8h]n`7%܋]ѲWEZZ ^p[kf帊qL`ɉ}4?paD@ p_䑌AEQKڲ۩ںz\֬r :hdbc=X.7nCUۛ v=kk]D=U+Sp'Y3!{R nU;fojP$BCnWm @mEtE4 |TT#T<Ŧu!Z-L7A㺽 v*څ+Y{CECCx[!AΆ*˵"<8:foz0(,*ﾙ7Ehlq,DKƺҮ DK LE+0߭W mE+߽n4va !ZlCh:jht^jbQ(Xn^2ZڈV'uz[*Ճ"1 'oom55 ]($7&ڽyzZ^T5vw A/PeӼ;zj5446Q|*0hn6l2QnjPeFO*/KRhIdG>V< %\*={{uM45xl dRJJ).)K qL/KVhV;ŊXμ-N8܈-@ٛQ>n1ʥJ 0ʫQUkE06vĬڊVf}E:dUrʍA^Z"hUUב\,avĤ$m/Zf'Rd!Z@$+*tںΜՖ{YSi)9^bqiED~aȾ}28V|:$aC":$:v~{z<<4<UTZ6;howm."DK UiYתo0ڴ/f߁d|/ ԰!r*~+% K 7teUU:vu!Z娒jl`{Stxt;5uluY:χC9b(#G adljFmi:bbeVYYU쓩A%܀$pGU-7JOzEIKԹKl0F !vPº|V͆∰ =UTkhΆԓvBјζv̶`Qj LF>N,4h] G3*>f|iآ;if{✉]nT%܁@5NH+(hWn*OIx3k$LӡpOhh4_d68ʳ^Em唛z&ZpY]B@ p9Kt4m8Sid2ɽXK.hKeMNdS:T gvذ;aEaAڬd PBU'X$c+r뺖lپס`E-k/thz9qUVLDw@4ぁKp4:$u%N~ cK"X@@|}r-g(*T8t6kOܨ."DK %:㎎;+۳=R]XF&z|ڎ\AeUm}i}e4(Sc^}Ϣh  wMWX,9,!@ԅ‹"XE!'C* nDQOj4 ¢Kջqrhc23%-j ;=ݏʼn&{UIu={!ZmH@8|2>4n?|-6LIb H[y\=Ž8wz\l)vуH|JCÆDriGqdpc.%"BqoEK|]N Mff:x{OK Y~?ӂ较[>ϐn-uuv|7O\fS8B@ p+Kt cG8̌pire8K8FpX)h cF~HGtxl- žhc곧;}@P᳣o>4'%-T;6vLsYkM {||:nhdo4΋]J?ߑFN^!fsp2*a9$RYf:n2#h ,^H*̚1.x[X#Ϗ+s ni5`ٽn+~St!Z(H6AXl2}vuzsx+>e\=4 ok BYEIUm>ii]&'w/h.ĸ>P<Ϡ~~͇E]C@ k6}sBGeY<|s.&"St!ZϰHSM,FfјX_k;Kmx[eyʞ DK R*%?m!nHEM7^JKoceد!c>Խ ;(uTQRV{7?ݫON%H/|{ǿ˾r|=lܱ__7 ɿPM_hW$I}yv!Z`@-r32ٲ} 7.=d&=#rlr{4 DK  Xvb< DXޗ}^Z-7ΟNHnɩz5$x+_ㅾ-@0ٖ_AJicI; YtN( ggdRrY"U8C;=e% ^yZ$Hlm?vx*Ǚ3 s4.Ir}\0\$SOw9fTcËD*!ZW&c ƹ0oj25 Uu*mWd{a!Zc#oy!Bi!̻~ ÆD05BL}hXYk IDATWWU)GR2"_T$ٻ?tPBXSh `L@ !Z@ 0,Ai,s%$ߎG/IsxH=m򙂪Fe0 @:T Nɝ6 k S^D@o]֨*|,BW؊-@ ّf4 ßDb;\yW (DK Q>g(|)e?ǿ{3-@ \^E~x{ryk\G,;r|[ti +"@ e賵-Zk%2FFI섳{ 8ͺ$DK\_ڼ]$SW1b_઀6[ۚu:z O͵@Eg?w!Zc#Yߧ^}jk0y}W -`w_"@h=%ڎv8y]1!Zcs9_֢:. X1|N' m)`l_IG礟-1qSP%El6SWWG]]$IB,Opp$ybӆ `?vu$Z3zAyfUvbQ065df_ v߱ʛǝu%5>+^\Z֢UUUSPP`}/((&$@BBB ",,#Fc} q ucٖ~kۦ*/UPX\Ja% K)-3mhdB!<,Cۻw3*~yB K@}ޘ2),,`}/((ͳDLL*fÆ CѸ㒹'h;. p?e4J0*X-L(,\(lfRKeTƏgtz]-_{L3 z``!{dZZ0} {ߠh6l\u|ZlB"&MIUa'IE=*Oq򌞚ze\b7̙FpP@WUuxGۅh :`ub`2 =2sc ,_uk3 lU^px_(Z&1}8|}Lf b E l(5-kJCDz|"E,u |aNw8ǣJ`AT~,^ex(Xmm-Ǐ `eI?~޼r]JnpZR%yAx X+O[,9Ž;HKKdDwKll, 2 ձ|r^UHĉ?>s!,,YBS`3'Z3{ζ\M hlO!;h#\q&OݷvZs u{e'I<*DkpyԞr+z;wk.*++;?MLL Y߇ ֻbowo>h ɱyzZHDrr2g;YQl4Pl6-lLMNS$ Hk&T2MYcRivwb9fۋx6!IV?Ǡק"Vy vŎ;qFtt4?0qqq 6㞒+شiO>$zcuuu֬!}9ŋYjѝ&?Ddݰe[EQV 3IҿӅjD6-)5y8B}%J;5!Z^?--Bss3cΝ9rfDDD)))XۃزeKZ֯_OZZNih4lܸeK.^Hvv5VNN.\b\l$IzjNڙ[ ^J&::RRRHNN?ɓ'yQUﾛzȭv-pO<gΜi[jO=˯e6YO0[, 2'|ͬZuFts|ɇmfJ G9bQ(*)R2o_/be#`ft-7t܏US[DeVX$`5Q%GV?O]=ɓ'y8qDSgʔ)L>g%--@֭[GppiWP[[KVVK6G]K. ())㫯WQÇ'55뮻I&ܽwq/;/}&ZgϞCʕ+ oHHgf@۷ݻws^E'԰n:֯_ϊ+{ YebA?Z;lG\4?n$1qT@A IXH0~44No K>ITE݇1̻~Jz&}T}7$'wmE˸2X ^lVj̊ }mۆZI&1c f̘ѕ9.AQ..]$I[Co6. ,]cnU}3jkkMnn6{A9:}﨨hYI^c2ٺc'O&T^?KL WVP8VHj?>eAn(#w=@*M>5"2ԧ3bUJ.UP[@P?@x_^ގ'|l,ˌ7M%$$Yp!֭/szyyQUUEccDŽyV3Xx1ƞ={8rHYK/#0cƌG{ z/uSm}ԿFE1b]7}][TUm{yU`rً~FdT"LD+4${eUMhEH-`FK`1L|g[*YuBBBHII!55.yx9<޽%Klh't%juUUU֩ @ZZ{zKS[J{r]5m@@ŋ7`^|E>S}.ISUom*Ԡ?MfC[?3;cnZAolfnǭhh]mLm$ۈ'DM?_k àAomK/l][DDDX566r ٲѲecvVY~OII FK[X`ǻʕ+;+oO[5 c^ f#oy!mƠ(Gy}ǸqWf6,ֹۣRYYI^^Ν#==CQYYiɬo>~ٳg|^ll,O?46l駟Ҧzz-^<|;f՞U6Ǐ#k3^r[cn-vV5, b!bM1vZ&޽{6 `,X)S87hxyl"wK Wr 7woKx'1RQQAeeeWEETUUaÆn:+B```/Lcc×d"44H""" Hݱ o{}?+Wdʕddd駟o>ӿ.]ga…<%G zm:ݿ{ IRj6I^ORYUCoY56fVjZiJy5,0Rȝwƍٴio_5'?a֬Ys zϢu]bL7hXvOnήp8,_~uКZ1&%8v"Ӧ֫Sʖ?]6kf5$i^ lRz޽{y]I8$$%K|r s___y{1L&ټn+ъb6"F71cߣKJJHL?((Gy[o;wr Ο?O]݀I#jkkE[eYn%55+V0}4eoKPP?;ؼy36lCJ}Ynvy䑱fAēNTӾDб3lJВ$K$żS =#fzakZX)bMWzXؕ&NȊ+;wnS8#!!G}^{ >SZ{EQĉ?~SNܧ$øq㨫d<3.I7պ//**5kְfTU… z;TVVRUU/EQ!''Ebb"Ǐ'))zͬ-YիWqFa4;۰aΝ7 7 z:ۣmTI46v9~`}oՍiׇ6zwE*%xZ!Z ථt<~8/b+V˒%KXzG3~z=zBK/1jԨnUnOvv6?~ '11 &0n8Əo]+dX1$ IDAT,233]"ZݝlAF̝3TF#uuuSTTDQQ5Pc a2G}< L0$&L` h%Xf -o@ӧOs1ewu?'d$šz* w;#B _oӶt,ok.^-+@mlLWt|h^]i&^^j{-S+]<W^ykgp)kڞ1qD&O̔)SHHHpFjj*'33okOOE PPUFƎg=QRRŋ)))~tҀ .poLy? &0aF ֑<쳬\W_}޶FUU?OYf $/A:3"+fԎrr ="ZMl޶fofJӒ;N{RvRUm|d*֦d+o/-1h^_3LG Zŋs=0xOp#!!!<3g?CUUΜ9û˃>𜦦&;ƾ}ؿ5gxyy1aH%&&v+dVrzdV]](pÙ0azΟ?Off&>Iuu5g/@$jLHH >>Çw9'fRRo۶mcڵm=*9w>lk_zhGnA:e2u\;PU}eכ9 `lj^][Rllؘrhu^'ǝ+//'jԩSYj6m࣏>n >Jnuu5$--ÇwIСɓ떽$lv_\\NBUU&nJmF"""HMMə3g ++W3FUUh:%qqq6BpL$/_μyxwl*}߿zwA7Oz_hΥ`TYɒxZETUu(J.Upw6mMO~T[X\kђ%0]X]SÕԄS)D\x.:w=\*Vk֬z;y9z(X,^{5~򓟐FZZgΜt7'N$55Վ=crqJKK:Uꕺ#ITTQQQ\FN>ɓ'ܹsݮu455qykfV"""3f III$%%1f z)ϟۄz{1~ߵ< uawJgfF)Mkvw~=`sƾ6{1vul6nܤSs90FqWB:'D z/Zo_~/ZEq=[jLJgyx 'Nt;5Opp03gdL:WTg7233]&ZNѪN___MƴiӀtPΝ###'Np6Jyy7$%%Lrr2Z$֮]˟'vmsSO=ů~(Z?]e76M{s@tel޺5w,rTVp\MQk&TAUQ붮։nV@Q]Z':p"CP@ A $d {s+=f`S{Y{Fy9*U_<̟Fhмu%@hɀbp@WJ˗/Jl#,, I&&&ӧGGѼVPP޼yQF|>ͭ@)..*H.iƌxx ^|D$''#//M*++8>}:::ٳ'WWWlܸݻwǞ={D\.7n1ydb]1.e#X,)i/\)>)<]ڽ|_z 6#?G8H<ڍV=Y,WO>ϟ?WFFFXd T),,ĝ;wV' # sss}b`b=UBG:2E(..)7"%0 ڊX!99)))R_8 8;;c8p6oތ$qAp\̜9pb9v@M8I\0Sϓ0lpOJ.%$5-^SSCRjhKvS)3Z~bj^,\@F{4_^/aðpFv$IDEEˈQhC߾}Na۶m TVV,A%ؓTJ%EEEIɢw122Bѽg1"ׯxu RH`pttĥKD'N&Nh b.@.l%mVne%2 ek5zU6bF+GJFXilcƵHjf,Q!`=x/V`b׮]Xf!zYx<`Μ9Xv->}*`rĴi3:v'̠,B5bXYYBm&LV }}}tSL@[[[׏󫛜8pӧXy i2ί"%_ UԩNB(&3E*΃gbIѪ ;$I;v ^^^r϶ f̘cǎ\(JhhҒqL:~~~HOR/ƅѥKu}Gԓ'r}z,T@$IArBBBI)NNNիWѣG@7VCt;vΝ;0ZF}$I"7ee,U;GtM:djF+)9>~^joV-%)## BԸ'M6WVYvGJIaa!.]W%ڪU+ 4 <==1{lp8\pk֬lT@ÃBq^us[*۴^/_dܾ}aaa*!Nt:|>$Ib000tvv^`xvp~|7C `eQV&~϶lMM@;$%g:X\$qAضFQt,6Z^`!jJHr?tuu#GRRjffK.brqy={VWWWnnn_$$4Z5!B`<|m0|h4|l޼GYki*4C@ FE!!\{F.t sƇ\ĽbsT"[$ 9$[2} W^Uj|A ##*3DLUj%hjj ;wӧ1}2SXX[{`{}L*.f~.Նrέ[5PpWnU ^xu>]h\+faX_u{EEEx}YYeh҈KhժfϞϣo߾iz>E©SPu&A c񩤌k~vFSoA:y< ڛDC574λA Y,w|rrrl2ft:K,uԦ0bŋ8y\Ɂ/,Y$u/ >\)>###Z xŸW'$ uzZUUU2=Uh4уs4Z ooo:u &LPhP+J'VjCx|}Xǖ). 1zX:G"{*z``^%I!~-6fN YYYXl޿/X###رǏWrAӱ`ɓ'K ={3f̐KH9mۆ}O>*3{C"66VP(Er 3ӧO@5T!BJ&ΝZhVZUg^ 6*J!9 ::)b?Ҥ).u&7|CUfc# ?xT;ڛFbx`ҥKjAѱcG:tX(wׯ~7>޾}ŋСCR:::Xh=*Ҝ~d*zZT///W{ʻIHH<]{{2띘r;v6="?=$.>+ W)))X|9 w VZիWCCCcA&MD3㨨(ݻwXd <(Ue<==՞<-*VEESEM/gOjjuuuE}E.OK[[[x{{;vݍU deeY[|ƍ8+iͰ'_L[YAPKښ $J;׿hYAU8-&)) +Wh*f͚aϞ=9raÆzܹs&Z`ʕ8p Ir21@^E?Si^~g>򘚚H~r>عUVXt)1w\¿@`2:'Nn<7C#QXy-ܬ%ܾ$RFShY~PxիW|io4QT(ͻrrrѣG)hUTT$IREUP: S 66VFiӦܹs􄥥bųBPUU5̌}>>I/6rY<} ɢ:ژ0f'Izfz7&&k֬S$)vh  "dZ$'NH}Ȼ_,]GA>}|HMMEXX"""f߉3gΤt-DJKK˗/zPVV̺ 1c,,,`ii KKKXXXTYm EVTT_1L$j ژ0aƍx*h X/aw{[22>:y?Pu]ex$Ŷu2}Qk$~юKk|Fb`Ɂ̤ aF^mݭV6l؀hL<'lڴ gM65Px>ojI0 |70a:vܵ #IE||<6n(>IDff-Ʉ=t邮]ZǓ"d06m1 887oT^ @{ `8IR-3]5sN4hO ^4"&m`iZ)y h>#![A_bX]QݴQ!JKK) 8QI知_1LxxxMl{֭1{l8p<@~b'׮]CppteCCC5 }]<-{{{\t EEEp8._Ri-ur3QѥKt۷K͛ѭ[7888_~rפf&/)))R6μy0k,<~ׯ_GLLBޗ;(gWu_ǸB!$ww ~Uhg|n~.]U'{kVSX3*տ:fQ];8 Цz<ijI-& Tw зIF][[($e˖zсHT߮];_f)}$;v m۶EAA򐟟߃ffTji(>};t耧Ok׮ `dd---ڪ噏O*UV;w.ΝdQ"P6-ZhfTt4Mi. &p3LcG?|XH* u:`]DG 52Zl |E?wAܹsc4i`X IDAT&+W[nɓ'fIPRRiC \ 喖:u*0x`$I"<<91vXʛb*pgE ͛75kHC%%%#33Sdо<Ž1zdW[nU1vXamm kkk̞=>|zO$O/|et qD*}ի"q֭[p0qD*'$$`߾}R䅘boMydB),YDܹSio… ؿ?VXѣGS2*L6 R5Be'V&|}[hGGG899QɓgyX@uT`tZ!((Gży0uT_~B5pwĒO:[>RdYL`D>x4Tt! A?D@⃌!q,$ ]uNO5_ ?yի_j޽{X`T8+**ªU&q߾}vZC:::=z4Ν;˗/Wj|?~Ԅ 8;;cJqq(QUaȶ}{꒳RSSN\MfЬY:Ƹ l6׮]Õ+W`aa `,;;!!! HKKC׮]jѣGhѢ:G VuxnBtP+$Nz9/8FQ r~J3J`UXPh̦¢u[_h$![&. Ob}.P;_:XrLy)S`|#ەx*,,ʕ+&>>>J{IӧgΜ8+$&&"))鋭[n"CfiiIgݺu044Ě5k(=oM}vwM;t(PqFvZX5-y@3(ٚHI?(YhŢ ,6_~Eի͛&M[[[;v쀵B())+Jgggx{{kڴ) [n˘6m\>v-5u  0k>T66ƉZT,Çj]Ϲ}60sLQ([GGݺuMIIǏc$'-RܿP]G䄞={gϞ*KJJJEknnTP2=zwK yKH"IcϕhF r0XfYCÑ#GիWcΝС>O3<ׯjKIɓ'8<Ǝ[C$I?~Rqpp… Z L%Bu UdvQ2&ZJOOOmujUUU8y$ e`ee3g"//Od^x!4U @ΝѫW/[h rqڼ} ݷh%$Q;>Q-w/d7hY,r7V?,S6mll``͛7#00ضm\6ö,onn=z 22/^Č3$W^^M6#%fff?>IkWډffg^U{. @js%dggc ͚5ѣ1zhp\u:<*!IHLLÇѺukz\֭Z[ɐ$XT ó#DV8/E Б `$͐*+H$ 2< aQ-Q->)>///a ӯ I`oo[bӦMΞ?.VPYSu7ydDFF"00ƍuI?122̙31j(\ĥQPP9UHDhh\BP\\SNDnZI0L@  (xB-.\ .@__ݻ7w.(#66jWZZk{sfli_C!IhbpvUjhrr aV@5Zl)WM<(-[^Uܹ3mۆ\F8y}&&&W:uꄤ$\pf{$U]]]~zꛄ|>>>8~8  PKYrb HLL LLLUP'O K,Q9( :&M3<qqqBttL*)))AXX`0^z;w@лwo["&$aߢRdi`suǸpAvxܸq9r㒉˗/}v444CC[͔)S׮]e^r ԩSG!H&.вeKUaggGYk`ߟsFnnnoVseeea`0еkW,\Ǐj*۷A;;x<<{ {ĉ~z<~pttTŋ`0|ῙFiY, 96''[ly(KQXXXo+VƦN7JӧLMMfq]dddٳuc2|/SU!T899Q2a3e˖QrXlJFB 4511ȑ#1rH|$&& xh]l6[m]|>^| {{{I?4С2Y4VO7Qo-֘OظqZ IfԨQ6lAѣ V˖-o>&EE*l6[rbUYIHH(SSI\\=zѣG8\Ra*:̛7(m>)ObXl߿O| 8D_WR#-6`<9rD:uQRQܻ6:uҥKl, NإK"J|tlܸ͛7oۻo߾ljUU DI###mڴPUU*))-r\ܺu !!!8s *++PUUJTUU1R4 -Z@֭ѢE ܻwnnnHOOG֭Pk8?ĨQT 8tʝ Hٳg )Q@mȐ!2dHDRR>|;wJ q9s#GԩSNBBB,d/o-6Euχu,---/_t v%S;e 򐚚*Qުm۶ذaCx<rssnJKKq]tP*))QR%V~u\~`ll6mڠu֢?+ߡrJׯqi,_mH5Ç%BΝ;cGxx8ݻ}D@ܸqӧOǸq|$$$RR{m&Uuш$OjpQg},^/* 0'Nldeea͚5 4< " *p8Nj/ JirY_ԥZGGG̠bE>DDDo߮RX7oFN0bSӧOcJ888য়~BLL #{vѷo_< :-hLFYDEEɵ߫WǪ$o>,--xɒKQQV^]'sHLLDQQZ2٤ATTQ(yAe AJJJkh߾=lll`aa'NgϞڵJ۹s'trDff&/_]]]4m3gJk\]] .Ǐ#,, QQQtx=6l''',ZVVV6C8p<>G6CF'(@8ؼyu,###KChhDI)&KsjQIee%֯_/R9bnnx5?~V&U^^{֭[J$%%!)ӧOd؈^m۶ܸq6mJ"""PPPdffÃ]&`V1AAAM*www5 ,ǏK Q?hAohPA\.o޼yk׮ŶmԦG$S[j;vCׯ5ZZZZ ?`nr4*---XYY5tٳZUGMCڱcG6k ?#O3fD暷$k׮ӧ_`gg' KKKEԫ%7Zl7~s1<׈#ЫW/4ΝEىjs֭[+V *Ju: cǎ"]āb߾}i0EFHHn߾Mi&жm[4o͛7 7o---رQQQر#uݻ~ QEVVrssXQQxmccgggtrXbʓ("˗/oQQQoߎr}BLL U x#|||bw 64/_˗/:>{{{{q8ddĈj%B$9:T{k׮ѣ($3g ** +r 36ԴCb|QfPOͼ<ֱh4~[y(É'$f͚UiӦpssCHHzAxv-NKCdرsbcchiiiIFl6.\۷o+IJ͛7+aaaxիM=k`0 2k׮P;(lu/\jhY1qDXYY+Vc"44Ttt:cǎ 6l@Hsjj*`mmRpJʗn݊b'TjGV رԮV‡~S\zz:6nX'jŊpuu;;;XYY놫}d2(//ǏѲeK$&&󈈈P(F,--agg[[[I&aȐ!Ju N2|`0E ѣGQmIx!KKK"Y$I"99믿ТE L0#FkR{ܸq ,h3<ǏeSSS8p۶mCx85$I 8PgT-6elӧ2ccc# oCs:WiBSSXx1;%*>c 57ǏǶmA8_~/_u vvvCΝ%f`VVV"77ϟG޽򖒓333>^~޽Ø1cm:JannCa\.޼yW^ :d}᯿˜1c0vX}|>6m333Y r5dggWzѹsg8p@%{=~W} L!'Ai$WI"AT࿘/i )%%%ruse2XnZ$I\zYfL644Ė-[tR 6L"ru &QġCbVVV"U]r̙z511(;;;o^.gϞ$I+loܸN"(++É'd2c2Z!GTTh47oI(--ӧqy <&Mػwڒ/8ӑ hoތ7R)=O>>w@P`5A $IUӱ]@õJ"Fb UСC(**y777Q94yiv[[[QEYAAA XxذaCݻcժUrCCCfBRRڌ֧Opt:۷3R2>|@uz"}\.á-z! Ř2eTDQ^|)νvZ 4HKKBJJ ԪpMܺu :u*+P \z=%1Lp!x{{#..NPz44`m))[o͑Uϱw|)OYܼyEEE8qbjIʕ+bڇ8VKCؤٳgbۭlprej*JVV%Ou1y١SN EP\r3fYYYttuu垴۷ضmj]*D[[b"''ш2P Ix JV&}sGK epv?Af0wߩ0LGFxg={VFJJ 6oތCaر5jTuGv횘uuuUV@\pAlocccY_€<$H\|尳ƔӧOSڝ#GhaҥKhҤ^rET6ԩS5peeeIa2GGG8::iiih׮d6PU'O`ƌX`] "q~G2n2B<БN345 <Ň 'ڴApU2>gsm-&Pnp:ynlgJhPf ,ƩST#Gɓ'cjφsg}}> ß)MGG[nUã"z ؼy\ ǣT \T*Jee%.^(zjIGbb"㣴HHn޼ +++ٳZc IDATZZ` EHH>~XW\O?t[M.\:N:<94771 :}2( %4Jل1*k$WoQ,s J~HYS2 :0A`H !:CZRDC{ZHlsNzikkc>xDGGŖ-[}v8qn… ѯ_JQJlUVQ.gϞ_̻c0QxMJѪ*))h룪J^L̚^ܻwOLNv/Ǐǝ;w`dd#o߾Ů]мysBЦ5k~G۸w%k`qqq?>ƌ6d2hl5-8p`kf50a}!4_/)•pcgGۛy3c@zbj"1)ψȗu|B"8\\V .ǜJ4΅"6fS6:r!!!u\1ax888`F:t)SUЉ;wt###Ejjo OOO1O֭[޽={2; Q_z%3c ={T[rX~?:: P } \.<<|B"de硳eMޔ$S ar@GG&M&MRCCgm6<sŘ1c0k,Z%|DHuOO:,YBiECPKΨf\^PXbcc%* $ .Dl۶ A`ڵ*ٳشi\db8p {ԯǏXz5F (U$PՙT~Zn5kۻ\\\&Je(!&% :m Z)vm&ܾqF/W{E@Ś5kv]uA$N>GSeM$I#!!@UUj0449,--Ѯ];|Wc̙~ZC/kZ;&'ODq Q0Uk8v 2H#FEs8L>9s#x<,[LbV^*q[D"V'$CV. Wc>=ѻ_@A2 0{(;8hiY,gUUUرc7n)-Zn޼?Xd ̙ɓ'+,=ClܸQK ǧozj]WLaV6 )) ǫW$ȓԣ BM:F& 2yVwбcGL2E)%<'M=/^cǎ{EBBDum'O%0BGG7n,uJ#bbbgggCU<O"ڵN񰋋 2;g>̭':X*(k&$CV>E&$_G&GhoYrxWU^΅ڴ5;kLl/عVuXPff&|}}n }}} 2 $ ϟfoo???zw AAA"""Ю];$Qm233-[իx x7`E(((@jj*=z@DDD ;;(++ʕ+QPV ֶJ#((wv%&`0>} --Mi?FHHLH$IlܸYYY7oJ{о}{-+WJ\̧Q*CЭGtHMg#'d;mYWO&6j֬%3PƩΊ+(BnY>ͪ ϲh}*( Ļw[NFWW6lPK0Fz聸8dggΝ;(++C.](Q[nQ¶meEEFx@w߉!$${C/Iaa!q-\~t:ׇ ѹsgX[[Qo͛رcuVyccc 6 &&&HHHPygYY"##q-hhh ::o߆+/_ޠ<((H U=)'_wM Q^ŧω/JPX\Nu@HHzH|:@xP-QQQ 0i&Tj!#Gw@=,.͵eHbjc? h"T !!z_۶muVIM*}Qck}$R!;;o`cc#x߫ضm  A`aT20q a j }:Ξ=+uM,XݻwDWXogXr=> www`cb8L%9(GV*Ywh}M͖Rd+H3jm&:$)N%6؟cw?녙3gĉ<e׫ݻ ݷg{OxkR/ژ1&|yjfSI 0skdx#\gfZ DСCgYjjj25͖a8s e'ֆ7lق6m >>JfΝVQQЪ<-8nܸ_U) | ,--annSSStс6Ԛedb>}:qEbI5B`` N8+WbѢErJb̙8t4"** 3gѣG7]/&hǃ2KP:6ދesw5hEe ZM@|q\ζ `p{>w}'u:֭˗/yѴ2d,--cܻwk֬A`` )piÕ+W+^b/U@?)=zhweeBڶm ]]]ޏڷo޶{ 7o {{{*--۷od2[ϻwnm ݻP(0`v2>}?~ ///1BAwۀ?C}ɓ'1gL:U!BxFJ UL]q)厼WLTT60*$еN@kT|0s Yɝ\TРO{"ةT*O.۶m[ҥK+璜,`3$hyKc#/+ڵ+l2EϞ=CttuEAaaa=z<==ݻT{m:.0`(((@NN@@+**MaxЧO|woj())޾} 0@{ ֯_=z 44T!刌ŋzjOs ]JT8V儒e Jv&^mUMLCA5VԆ^ڥ+}~-gZ4T=BvΈ#/ZE׮]:S1cЯ_?ٳ+WO?$M>ɘ޽{411ٳg媮$ 뤂֝;wsNq_Eо}{aРAׯBy#c[ܻwGYSWW;н{w0L$''#%%?չǎٳg1i$̘1q)B.^mLn ???q H>^`+ (/|%-ڝ;vI``@^bMV06jf.؆V}=R^`i {>|u0l~?W4,ODhTO?Z {Ol߾]`СCny//oݻwy---`oo8pފE>?^x hhh@WW`2 =~Êm۶RW JDD?.W*N]]GѣQPP+W|Cdܹ3dq+VA۶maiinݺ!..000@`` addƍ O[lK9rDR 69) .|ÔgG/ cG T4a#~_ϥT4*/l !`nYII>M*!נ8Y+WVVÃ!VT***իWaccçHn߾-`^PPXҮⰲ͛1}jNTTTf򢥥>}`ʔ)0`( ޽{Gڮ uuuٳ+Q۶m :o޼AJJ  FÐ!CPQQ!'/UUUz*`aa&[ ڶm;wʤYE -:%?C}=E:*mF TE }zIwx_)0VG~&VvC֭[CYbާs )f]{Ǽk֬Ae>NDž [3F(SmEEEru///899)-?;;;|ҥ %~\zFFFرBO>+'WQQAPPP0 `mm 555(^l6>|w!!!ofJPuVS\X XPU /=ШCҟģn q1#l!ɡ!2^FUu >o/3wx9L /MLwh !+99Y*nCCC|߿_` D>}Nnwٞ={sHKKý{œRr49s`-fpPUUJ|_ * * 555|ֳx.>|8dɓ'b)((j*$EQXXwmnYfAGG vE՜܎Sb'>H~]Uu ~x =DGF{]:Zcδ8p$UU5z ⫗3^?ыA=ݦN9s&i;w K]uDGGf'mڴ? h ĸqg߿666 Sv>}2 =ӧOQYY ^Pjd)jq IDATiiAGGCԩ:wi?~XQCrr20m4SGKU`ذauppNRErmll~~s}^P;H@ݺypfR30_C%䌃N6_5 (n!8'E 'MFb6-`vHn޼)󥪪 5l$CZZ߈sʕ QQQQx Ο?+\e:9x`)^VVHJJREEE***ҥ\ڵk `ܟN:neP}E߾}S>|Xl$"XnU޽ŋy'N3gJukkkS)ظqBTBgv!^R * Ǐ+2%n!%_X@Φ jϞ=_IKSSN"8-ԩS'}TX`ӸTxI1,gbSC!fU%soN>- Kz@hg$ע ***8y$: I]%YRfÇ4~ccceRsoU)9Цܾ}LԠzՁb %氱ѭ[7*H?^l BEGGr}56m91vvvغuBI)1 g&q%@z-|k}{IRe9yɳlbnA ZDzM:tB>|86m$qi/.A &&'98JV~~>fϞ{7ׯ)BA~̷R=zz555t:u :uꄎ;NC[[[.Wr~ <ȵGaoo1c(رcL \t:BCC&b#U |fl`lcUZ;0 ֎W׸kκ7t TKMmO˺Df;J^I -R6h`-ZDږ}Νjl69l0l޼uZ/_bż #G(] >tttGzD/Aً455e9sF`$&&ɓ'8x"i FFF֭u.] fݻwx5۷oIYp166F ===_MM bbb'uWB֙5YX,|}}qmRk2)^@wcgr ljkTcGn>9)@M uC߸j y,p8Z'GQ.wk!H-fv)Usss1gR222/"aq%l۶ s9ٺu+={6~]??utt4KO޽{e.Nǎ;`jj:۷gϞ?KT5"fn"FY(r / is!"` =GGG_(_D,_׮]1dRDUJLLx?C;wfR***Xj233y^UGOFttԳaȑ5jHIrC D2K1J Bj5'O"-q8"55:u¼y0|pۇ@q oof X@|ۦM@Rqu 449{shgT 7 8~+)b(/VҔm"kHRIU BTvŏ?yGٳ'~nJ+RSSSs]&,zzzؽ{_c;Q Xv-"""dXA`سg= ՠLJJ… d$+n0sttĦMp8pK.ŀ߼y899ի 'DѪU+YldyKg@2h1فbN6666Ma8yRPmdРABE6?G+L6 @В%KO _,۷o#((H044DXXK%W\E& apA.HHLL{F'4xxx40A055Ō3?!!!3gygo߾E@@pל9sm6&Xz5N8Ϸ0( V\)pok֬>a1!?ޮU \\ hmcUqvgtRˀ%g }X ; -CA(a9x5/KOO wѸz*KڎE>4Ѯ];fYcǎ ;iay9tm #Gbܹ2?z˗/ڢ(,,͛Q]]l\h<&gggTTT 55HNND`` bcc1w\5J ** " TlܸY$*++vϟpI3Qĉ\RftZk9zjG[#/-~۷*IQ4eM5W--- <7`믿xW۶mCll,͛!"""}v>Ċ+^| 6l@ff&o30j`](5)7dfgBdP;vF9&)yԩҰX,\r@ì6}!!!A:0>~ZV-i&mFjQ[SS`RGLKKe#kNao>^IK̲`nn///ϰE^^1o|5k4KMM 6nR(xxx`ҤI I>e`|-fv6%p;w.fΜ ooo>||>9GAy* L2E쾃 ¢Eb-ã)zaƍR`q Oz k׮ؽ{7f͚|K8J|ئBzє+Vvn)LLLw^M8ձdL0 r]^+TX,nZpy1=z{M'ݻ055U:YU^ ddd܏b! Ř1cʂ/^5557KզŒs-u7$-FWjjjF{IL,٠; s_{ۚBuAQڵ#9122?rFnxZpUzĈ! ;wp tz{&ٜp8$%%x5JHcٲeR7>9s""MMMwoJ$ [K]Afv*OZ|B*JOOB Dǎwwwx";vڵke>رc5"##0eXYY]=]x":ם;w>:u"}fիWCSSޘ4in݊fojX`C7..p^jӦ BBBZ2```6Li 7פ>tt:eee"-,,0lpܺ%( qhGyyyѣGK=lݺ5oWWW|7neNt\cTUU#=))9s? g2-//9Mf1HB`2dbccq\v zzzppp1c&5%-uuu8z(Μ9  ^zaȐ!Rؽ{ؿ5>BCCJiW%15Hp]vEFF i ΝL wk֮ÇKXLV7T}}}cժUHOOǖ-[/SrTZ ;whBNLLDLL Q<==[r rcCȅo.3;[In۶-z `ee%2m&L{n?i޽{5:6556l؀ **J&Ռݻ|@CvD.4b͛Eȁ???koʠqa-,,RT+Wbܹ8u㑒ƍk6WÇ|UZZZ8p  kkks۷oy}x% Ruh4,Z3gl;b`Rx}̴ $V__/ Yzkرr􄟟зo_Iu  dJ]ڵKl3>dI]]A:צ4Ϝ9#WJcڶm%K`8}4Μ9b9r lmm1aX[[+᝕m۶T*6l,--Iܐ/ʕ+RHNNnddM6\ٕ_Q @.hi&bz^,555 2D!>|8p !::Z*0F͛e:sؑu wudS*++Kdee!??@EE  B롭֭[CKK mڴ  XcHa8u‚mmm,\ӧOٳg2ܻw݃ƍGGG|੸pi W^ZGӱqF3!!! ҥKg#<<\ O9x IY<|ȤrssRZZZ_ ױoUZ:`  Fɓ'օLPLIP(lڴIfߣ;w -LuOY,~7}I+ 4f2lxi*.puuEhhիWի?՘J$$$`ݺuXp!* *-ZW^痢aFee7n@6m0m4>|X h~4Ӱ0G#*Lܿ/^ڍRWW'5R6̲;ڵk^Vr O(11Qh$ڵkEt?ֽ{w߿ӦMxS(((@`` y)/ׯ_#$$=""",ԩ°b /^… >#T*8}4\]]&$,cbIMMY X"02ni$Xԭ[7R/9hqV,3.]GBg(ޒ%Kdx,,,/_w}k ]߹th"_2%A`ll CԄȗ>|ׯkH%8\YY8>}֘2e   A:u*lmm}v޴"lذcǎˡ+~1rHܽ{7nÇEjɯ63/q(~e҃]9D٩A.ǏG\\_i7Fӧ2w2QbΜ9pvvyLppAyî]$*&H6ؠG022RH1Fnn.oÇfQHLLDNb [ha׮]GTT@ŋ__ߖlڵkbz W- ^Xq IDAT;ʿAM N&h2(R`qm&&&r͛7(**NoJGccc5J!y 5kH}\nn.6l[$+VXkjjSv:w7o*Ć#Gaaas cccsssC<|III;QynnnRĉacc;v aX~}Annnn<&a=zTA yyOe@YIIIKK(mŋ%srrr0mXdh055ŧOe9s޽Aӓd۸> {{R^!|7}6>~(y&O,u_Yff&֭[h4xyyQx޿aB,Xh`ee==f-ֆ9FI&AWWB 8, =zPji4Z__;wVVV-Rdllߋo߾00E+3rW>#II'̴uQՀ5bcc/^'NƍO)3; Uj [lqvZ֯_K !00PjXcȑ#9sfK𡭭)SC##Pjkk)I~~>^w1110`'O\nR]4ZѣRU ̘UEonU!HzSTRMȝ#:ƌ{ptt_̜9eaeʦK.2۟p9!e?WDD_ܹs^iCK0z쉈+\Py!v!/7l6,,,*rȺuZHC}}=Ο?UVaΜ9rYضm,X 0z!-[otmPK]PC1sL'%%81"IEzEVR׃aAKy~at+WD\\v؁cٳgh"\pAj7Zn ccf_.0ģG277BAv0ydaz Q&VZ-Z< XތCEE8v&N(vF gggÁ%KcF 899!((h\lL-***XnN< '''ܾ}[O.vBbΘo`yE@p4R$,Y—zh19">!!!B#111q=h𹪑Ap80аhI 86Gػw8:: Ĵ6uΜ9OFaĈh߾=~8;;cΜ9~_߿ǜ9s޽{jSUUիW\%hgg///ҽd, )))s߿+ FC^0p@X[[+?Dxxb.]O`lMM |||fF ~uuu  ㏤lpsܹ3|}}Iٚc…"Sgŋoz `1$'nٲe%%}E8qPI.]vȑ#ŞǏۦWWWeBK.pttرcѦM<|ש"=eRTTQF)\Mah( pB]Vbv}v\x/^I f#??Ɉ瑛 555>[еkW3߿癇6W\A׮]+++a  H%NLRagg$%%5߿`0G,--q%X,?DmK ]]]$$$}SNA,|M Z#L"{ѣGjYXXHdЬc00ahVлwoL8CII Aє$rEy*(--5Z[[+E!""B2---$ q ?-W FУGs044Dmm-oP'dffHHHBe6䢮o;wFbbZ\~>` ޽{M"q]ݻwѡCgmڴAy555x.JhNJJ*UYYW7f0nkU!ܕa3i$JFիW۾&  aÆar ֮],.]BMt{ DDDǏ!i&TWWرcW}8}a׮]bbO<ӧq]:$v XXXbHMMEJJ RSSDDD ""ݺuѣ@HCEǎ%fСCƍQ^^777}b˖-rYaϞ=pww睟 004 C%}ѣG#)) ׮] iTTT쌵k }HWsp״N ;|p}6s? AAA|26WWW4+y桦NBzz:;8::bɒ%UY`޼ybm˅1p@ lOOOK|%55nnnRt:DСCBׄѮ];5 GF.]DVV233Q^^ `bbtӧԳRT###4eދ'LkHU!CUU\\\˗K,SEEٳ'v& WWW:tHgN[[gFTT/^,"-Xj0zhRGXn J8p'ݰ;v 28PTxzzb֬Ym555 5k_C.--UUUQ:v]b( [3[k .B>|kr_WXZZ6Ke7o.Rؼy3߽{..."d@B'ObܹprrBHHkiM GAA1}thppp@tt4o333 U_UO...?>uaa!|||H5q_օp0bS@+9(%t//!5 bL[[Xt)X+Ԡ" Zsnʕ شiе8qD;v ~-n޼ 999x\i &L zРWWW̙3ذa[cZjC!((K,^%pBL8ɓ' #}ZpY/@WD۷DeesbP@R"EC> 0c @GG֭[I5B,]&+o!gϞEHH>}Xf tu8I^(//ǎ;x% L6 %?j|.q*\|+a|eT)ɩS"Z 43;[@} ZPHnjVK J VczhXYYڵkXnTp=544`f/طoThjjݝoEsp ܴoߞOi666BQUU%65WUU۷*Z۴i7: 44 ,ϱqFR;H:q.\AByCZBÃXL%dW]]] , C?ABH/x.,hI*\rK@yٳgXlXƦHEzÑKΝh]Ċ+8?~m۶ aYyf̚5 'Oƞ={KDFFk֬yȓrqqmpiX%%%|g[NaO 랞x)Hu7nw^*FϏWb#1Z|ǐ qm ӦMتU{Beֱ|$_":=?jTΤ͎3-. -B@@*++|rsMIKO~n߿?~g]clmmE:FPSXx1aɓ~:d2y:deeҥKػw/֭['LJ'H___!AQ888`ӦMsO;;;̝;W>}ΝmˎbӦMSƍ R9OI=ϟ/̸ JǑz[*tDLdi5Сn*1헛+sU,8qB@ؘHՋ^` A`ظqX:={̓L¼nPT._!C 'OŋI3|k2i=Nym*YYY u,Jżyx%ىr΅+ =hD%{ 3y$gXXX ::Z"ʂ%)T[IC6;^ҥKGMM Xpsc SXhPAܻ',#X Kb׮] 3h4V^-v={H ~7U#G)kB&&&浪|fO +U 3:3C_{/kŝEnn.=z$1fԩS|!88XQFF\\\fҔ7o +)QK~0l04RTpqqJ״+2ʹ$@YY4QɖYK*F!U,JݹaVOԩS^߾}غu+_I0^zwwfMaaaRVÆ xTDWccc'$ v]]lUE%jt.M d$ќABjta*Je[-O_\aaTH&MKU!99P;łg=(--ŏ?7E1i$ ?~ıcǚ~@pE6mz?} *3;.ִ/_> 6Pl BQ$VYmS[WWWf֡&`~i3$V9rDg9p8 AjjjCcZn#GҥK%A&lnnK^o۶M445Yjjj2t"744h}IEv6œmmmB ZHNNwb5[yqM܇( Z|eee|]FFFA)/^ѣGI]OMM VVVTUU*B!77R^mԩbgqX]\~מN4ܾ}ݻ2֯WRRCCCs A_" U%VII JKK Z\gֲ2~*** mmmnرHualܿ_fE5PNЪ\wkB]hĢU|;wŋ7߈n޽;޽{?IxcƍPZlqq1 PQQcccRAK.߿ؿG||B=v777 6 ;;yyyHOOǹs0i$[PPltFK n0g3u勂 JZ@Acmǿ~baڵCaaTKRѿ1VVVg@T*IA&5VYBNNu%+++f]vŞٳgb0o<̘1CN]]]L0&L'OC"00PD}}=q9OCδTYӲ @ G^W˔EYgVWTLd2vZtԉ5ɣcǎX~=h'=={U]Zܾ}iiiv~ׯ_;wL&SayBB.\H:eѿ:u P()sΡ6l5k#99&lrNiEellFJ_\tddd(F۶m%KPP(DNNS.YBaa\루]T*NNT;&Խ{w8;+v(((,Px<o߂dG=z>P;f|rMPv<|ߗ7|{{{!??EEEhժ:u$1ORR̙CK:s3gZj 7n@QQnܸ3|JK*˭fs8H*-kkkf⤦"551E#]M"JOpDREA6hTL8 Z/_P^`c} >\BaC'NÇ9%%6m[[[l۶ +VP.xظqPP(Çq9ɜu}A֭(,={T>}d9Rsp8| 8v8p{<.wrRGQaRSd055T+h5i555(BJ욤,z PJgHb S 8r|||pq"** 'OĮ]`m?ɺ[\cE}  ~zlڴIBd˗/DZc0|]lR?:.KBF~pR*>>>ŋqmb06mi1-URF{hujq=BL@Tp<rhEAl1a,_t:L^m۶rٳgPDڵkפf '݀, X$$$ 22?Szm糳 Ν;Gj 3fBc0??'Ot>CCCJ5S7l xvGB ZвѣO?##YAKSV寿U):;;c L5h) ?~ [‰bҥrssd21x`R#[YE0w\?IR3E@@cx8wDƍ)=~;vTKiD|Z9rH9[/ 0|u#FPLUŢ0Y6EQ9=hhhHJbaΝ>|DT_+5Ycgii ___%B5=( =E#bYϡ8ouu5 +dee'%:ܤIF|_TWWS _qLk1b<==dlذ'N@vv6y=`nn$R۷k׎,++#Uȡ}}}UC<.wZ'n@/666]eee(((ߵkW4ӧOeB)h(>Djkkq%XXXER>@[[[䄮]% JFI$]ڌ033H):vJJ  閄={BOOD*mӦ ǻs"!c󉢓r)tgggOÇ#''GaiӦcǎaܸq*`Ѻgs8s|hUuovtdѝ¨OahhZT___̜9SXLe޼y :tb9z S1ǖvRB :::ĬӧO]KK ǔ)SuVDFFbƍDR^:,KmQQRRR &`ǎr8E 2H϶ڷoOMX2hP"ץdqMwEp 33S!M۶mQXXHKFڴi4@ = rpp@޽aaa ЄDa*$JW P*%3g9-e۷zSt:&O o\YxzzNHH IN<y\_48jʹuF*!3ehhvIw}j *V$5`&A! &L5kU ; ǪUpQlڴ ƍCAAII]7ҥK-$@ʶj 'OD~d~. I\z nݢW:36m`СR|>iiiXp!f̘t}{\&;v$y<K:ųj--9@#_fZ,Uvqq1>}*e>}"m*ׯv-BcǎJC:88TT:u"f|>W^UOyyD0rE*϶ @1]H]iߙ:w7oސjH?~;P'o- f6qJ3CYU)%;KKKe1&Ν#JeQSS#Q E @Z ZTҲXr%m&7- 6^zaʔ)ů'JlK$SaСĿEbʊ?ǧ\rF_|ڵkG*-SgUV+_Sj/۷oUJr?̷nH޲eKREg~Muu!;;Æ ;pAQۉann~c#()FVeСؾ};YZZZx1bc{/)L?050JT._vMvB2{ %q={RF"6/PCbdggxQUUjTWWHmmm4i҄˗D0c0Xz5QF!M[=3ߧ%WJ̎gƍ5jYBΝw^hkkL!ݾ}[BFhرYu3-Q`( ZXz51xVZaٲeXx ޿ponhh(QXpBlݺU2l9*rsƉdɢ,hDZZ Dxxx@OO CsMAprm:X#E@֭[r'8qxpf@J`_~8y$233ѱcG*!|2"##%}M4A˖-ѲeKj 666``ٔS~nnn8t$￸yBYE?TǏ!`iiya۶mj PRR ؟5KKKȢ~HqKvvvصkjjj`k8nԟiє1@lD3ǿ RB-H5–Uz9s,ObQ)urr2(\P(D۶mm6ؾ};N:3g`۶m Ĵi0`b*&&& y\ a::ypppPMee%aff>+VTj_&"(+ϟ?ǂ $J'BAĔ)Sd2Q\\C=, &o޼!~҉sXVVV<<<0ydlٲlRi$ TTďt! ZPZS-yU@}8o޼zB.\i0l0 :#GԩS1 hтPptt{+.^(mۂbɓ'AeC(0>^fUee̶2iSti9LHHh}`gg7oرc$.( К+՜Y#ljQw] /eh\3%%%8s  jkk! 1n8aդBF"S1`GxThUf18ӨrZFHIIhqFmyyyXt)F%KӧO'.^(Q>yd?~WF܈Z![GP@]^  >>^K`0㣑)B_I_7UUUh֬d~ާO #fZGxx8,WQP(!|*lbj1yEx9Ktʋ SvaРAŕ+W4r:P֭[2"h޼9*** ѵkWJIII011 \R:>.\={ 7778;;Sr{DENN&Nx\ou3& -ԌA"bEU {ɝHR}􁿿D:s bbbW_9L r5ڈZPCu}?wCߥJNX,ϟCCC$$$htD9e)dd0ab1b¡',wޭqIUU x&z5Ν+PQ~۶mi-j磧Ȯ,L&5`/'N֭[SEfƬ&7E!5tcؐwRdgnee%l|qno޼QY \Ǐdzg(~6$϶#TpEE^eꪴ?i݄ƴi@Pڵ [6%2S]$*C8/֭;8;;#""B)*0x`,X@⽣Gѣ2i1L-jdSWb ͔)S$R8}6w܁&O~ PQW1֤Is|M/B ˗/E555jy:1LVZ B@@\xF]qd ѣ1bɍƹI} .}R઒̴[n`@dd$6mڄp&d֦TN?zhݻe}jGGGGjr-׵ wۊ v-Z9B 6`ѢEѣ*K2a„ HII!-<jUƍa8ќȑ#6z`ժU `X ޽{oooj'OijgTjR`<Rfc֬Y$֧޾}uIl[\\ 0p@R;t5<)MԫFtt6"ynEi Z_9-Y:P"KSN\߿J""ƍ]]]ԳgϤ{L&a3V)¸qnw]۷@bPXXE,ũST.iӔNudl2A[[%ϟ'*PRRBڐAk5͛7H;1hh=Kķ|yyyr?o֬ј*">>^)]g} 1i$:u6]:CMM U=tTAQVV.L>bGGGlذ(3" RSS[\tIBӦMIwҤI#~CCCIcbbPYY*m{p)k| 1:VIZIWW2S7o&Zƙm$bΎKQ;P^ )ӫW/رA1cƠL:*Bdgg#)) FLL BBB wwwL>Ɛ!CT6  XfDM-Bn=W("((xȑ#?eD#nU+DUJsa@ӧOzk׮P8{,;"0 ̜9O :uJv5IIIM_?~ݻH-sssMk(4Ő[Gi<OΠL&,XP 0qD߿_㳭,Z cǎŬYfl߾ǏGjj*233[3{fZtj~~~J Edd$x<tttZ#*GG<$m&766F``\ #Gbx)ҥKJI7=Ӂ:A ~ ӄxBPkVk!;`0`QDaa!n޼^zO,ӦM#mN1cѣHNN&>GgϞ!..\.0dX`XhҤ b`ffmmm_x-nܸ!1s"Crr2\\\0`m۶x1ѣG={o޼AHHkY^ o߾ >/SnׯWFԬY3DEE)Uf9s&޿$B*I__J?C}B!)A)IIIښ'N$zjkkXO{1h5"+hP 0p@R%gϞ}v͈4kwww*K]zjcҥ߰a:tKKK?Ǎ7:ǒe޼yx)2{a޼yXjxlaa!llRR)r顪 eeexT7o̽E"f0Xd B!a{3w\HOOP IDATGBցɄ?&NHz'luu5._,3mmm<" FE+WģGмysAOOɈQTPPTXVD)Ewuy-ˉ`k֬)^@Y;6 Zlht 2Ȩ8|-)jjjkXšRKL& .ġCj ~'y<.]JuETa0¼yTnƃq9jzzzs۵k۷LJIee%pu4mk׮%Eݻw+VI[O`Vp\0LSUUUr7o5!C%OWWzzz`03 M>2ƓƘ={6J9x!!!xvZtC  66VwI.]djROϟo @}}}tECWOO^4+V-58}4%͛cĉE˖-%>sttDBB`aaJB{nҒFFFhݺ5)UUUڨA^^LMMi)aee#F=Rـ?x߿/_/ѻFP3g 88h߾="##T( |-%" |rJVZ͍r1X[[blٿ<7o~}l553%ԈfPT}-~o4iK++7&LܢE =x}ʚgT0119suV Ě5k PQCǏ,WѣA5&HlxΓ㤼ڷo.](f̘1HLLDnn.rssr޻;v@bb"x<\\\sN[[[?ׯݻl 444D=`cc8o^^mm- [Jҍ> Aɸ>rss[JUVpvv3:v쨰HG!ܪG$$$ 11EEE1j( ={5Q rU |@^дiSXXX 55 Dqu&I[ڑ *`(Jq*b??(]RmۦT,}61X'&& ݝxHM68tΟ?mmm <cƌM Ǐ'|-[&1@Œ%KH[h?v { 1o<\}v܉:t@*o>m۶Q?|||$?z쉰0ZY6ӸpMyB&IzGjy {!UZyL6X&MڵkI8;;GTT%׮]ԩS|rP5KmO>!((TSC `PnIuUSLAjj*&O#G`…jX,t֍x-7RmV"6"Bo  ׿źuAe.HITӇUƳƀ߀̓M1h R YYYP]-Aׯ_:y9EDDӧOՅ?̙C)`"TXX`5k1h L4Iϗ/_bݺu4]z*bM'ۘӧØ6m6pvv&-JH``ٲeR=@!,,(^ U>޽{aÆIߺuk^X|9N} 1mmmZHҘ@&h.sEu$Fqqq2En+++Ox#::Zjsss,Y{Q@nnnطo>LZ,/Xbځ+%%EBdUA𰶶VSNRNٚ@}BX%/&(((@bbLD)ŏpRdҧy@ MƒJ1 'C̝;/>!**Je wqfϞ kkk&"@B!,Y"S+!ΖXұ:t@իW &Ԥ9yXZZ"00t*{E߾} ^:믿`0hт(„ _w/^m۶I913L m5>dmu]i/P'I&M3f+_NNN&n q޽{SRVDpp0i&ZiHR/|>>>>2Uq)ڵKs?|P⵳ E(CCCR "::: fgg+VH!Å 0`MF"-JO`ݺu۷q)y.]L./n4dV.LJB{||\{q [[[u6Ri*h޼9,YD,xk;"&&F>8q>W^ŦMZXT> iyq}EgϞaΜ9ͥo1W;#r&wpp@۶mOOOWEV}vko?٠u4ӧOW#5a0)e ))Γw7n6nܨ_RCccc-[AcBl޼V Ś5k  ղe?ӲVXdLʕ+Ǐ)`RABjȦɓ'Ѯ];T\ܚ *5&@>} qFTܯWS1aR7۷%Zaii)J^^^زe -=P򂝝{8qUCcffh6UqM}ɵ%>UMJ)0uurrr4"4+ {n\h,&7ƎKz{@l-GSN#SYY .`„ ׯT1cJ?uHCl:i/BK K.%U+ (..F^^|}}%D^ 3f ** 'N5/ҥKGxL /~&000ի`޽M∧wU Z#- l[Z޽òe(U*;t~5;wƔ$tuu%ĂahhHˌ |1H-6@.oԩSn{7+W0vX/F>| &"Cyy9P[[ '''46-Z???T|r,[ o>|$$F\ ZlLC;x<CUH9 :tG||<<== X@,tٲe7n Ff+ׯ_ׯ1ydJX7n*F44}F4*z>;hzU 5'\FfpUnЭ[7xzzJ"bhٲ%$|ӧ ;ك{U!&Nǎ{nZΟ?9s˔ZPUU%A+E|탻;bccUN+lBWj^X~=o߾{g ر3f̐+I&RͶ Ղ}(-6s5ҥKUNa͚5Dr&Md0 DDDHu@A,ܹsKKK,XG̙3iS022B`` -[F"g www>|Xi۷ѣGxLc:Y% 2 Bܾ}AAA4i݋Tkcd0>}:u)Fe[n'*ŋVYșLDód?9 [6գrF 2?S!!!R#ݻcĉ(--Epp0j&:h֬"""h"p"B!0e$&&/1vXZg 4;wu}Çؾ};ƍ@,\w***P]]- "͛GT|Wr())Ç1e,^iiij5!** `0۷/QD!Tݻw%t Fym``*ػw/ϟв^EcccHr6z Uqԕjʦ~r+f͚YYY)oAXXJJJxbYF9ùZf KS33~iaajM$BpE#Z===šcǎ ףGÇQ}}*++RG=N> ۗ7nDtt4 ЩS'abaa!C]vxjkk$=z<={&5Cvuu5xuՍ^W"77?*+++,\^^^2S6668~8ٳ7n ^XR8ػw/,--%֒9T@ެ2}N9nˢ|/Wvդ5kpb׮]*|>=`R׬\o޼}nn.͛GTM26lP!ԥlɓ',7?z۷qQOP-;"ܺu 'VZSbݻwiK#bؿ?\]] Ӄ/^ѣGǏGU6a׮]Dj6??;w%ܝ,_S}e׭ֈJ0rB*Jybn0 ɽ_xk"''6m"LW^!00|>ׯJ4ipqqQBgΜAez\2e <<<x<$&&b hllLT@GG(++Cyy9_aa!hiiaĈ6mi,t !Dvj8::NٳJd>k,Z:::طo&;>{6j-rx@ E;? դxBWW݋sMXXl PJ!;;QQQ7@ Ν;8V\I ~E_~!}UDDD-\UUx>}w1w\f z󈈈j [n\.|L2FFF@yyZ7pww0i$‘fv9ٚ8p#_:=4RZZ9sH[l!U204iQQQDN?99?~<͛GPP JJJrJܽ{@DPSRRn:>5<.]ڶ@ [p\~?LݻwԩS%\K`WRROOOI&غu+|2ڵk\7o)`llp!Кp>p#_*b̬\йsg\tIaaFAAУGǴ%RSS '''\zQQQ֭.]<N:oի5kրBGG .Č3h*-,--s.d=} 777L0Aퟙ`f_~=z4,,,PXXHkׄ31ydUDd7mڄGAKK ıBbb",Y{aaa2 X̙ClG-9|9Ԟi@k 9 34seq 0dR<{,K,F[[[cjS᯿BHH,--rJQZZ ___hժ̙3?_S4۷/FѿÇPooo9wfΜcǪU/Q(w֔BW6yʹFjϴYuiaaZ)bgg*Dff&1`h߾=:t''u;v?Ν;M6ڵkU1c̖.]h;áڂqj0g+044ƍ^z3NT~(ex<,XYYYhӦ """t[///R)HMME>}zjs̑  x"كC__ǏƤ)**Bff&ȸ\.- C֭ѡCo۷+L,^ظqƊqIJJBTTTj*^x$AY$N&A Xsi=rrr0|%☘ &&F^͛7yfa \1118~8:v숰05|$$$`ԩjDlذ, ?3Ət:u Dii)0sL ~HtHX|044)ڵkvځh,ϟ?… ѬY3lܸta*U&$$U:t(dܨM-C)eRBjj*BBBn׼ys3fjDFFޞ޹s'<=z`ժUrGHHHU~p=zTjի)ƱcPUUKKK5 ÇGӦM%=wN>۷t"PTTBA__(g~XPL,\o###DGGk̍X ,@v0w.g~~>fΜ)smR__!Ї9W -453--,L0DonW^^[na`22=L&`llvW^ŕ+WХKtvލwXj4 Dq]Qm}/[L  6p\,^:::w"\vVP(D``u)SТ"-laGF|QhZMia!@.Ν;ӧOJ+ CRO4IM6DWJJ :v+++uϞ=+IZj>RǷ|ii1bZ3 cƌ9^z;w̙3HOOGbb"x<|}}Z8yyyX޽쌎;~ҥKajjH bĈ䪹#88X)ח553|h$h@ia5ײ=zO>U݇C+++7l6RSS-[Vkܷoۇc ,LLL PSSC`00ed 6t2tttжm[=m۶EiI <|&&i Ek^0o}]kDFFr9ܪ۱c7n_~,]d&fǼyɡE|4jԈ]2j(\\\xpQ9qvv6$11777c%RСC,Y-[rJufeիܺu kkkzͯʢEȑ#T_qՆ $xU&u>EBt.ZY'ɀI^zܸqCBNۨQ#<<}₋Y3Ĥ}i&;wES:'NI^ $%*L&Z W@{[aϏX׎7wկÇd)JVZ? $:''˗D``ѳ2e iiij*Ñ#"""##94nܘN:ѩS'\\\4ٜ}Ett4ׯG.Ŕ)Sto-[p.]jMBBzceeE@@؎K{^`חN2`'mR9~8666lذ({{.~~~ܻwu߭WٱqFъ`HLL$11[nHBBB>\8;;@&Mppp@&o֚DPDGGӵkWfΜwwRR&MƆ`~ ٳ'Nu?~K)ᔘJ]Lj&8\|jyAXr%>>>$%%U{͛Q*L4Iy6l1cI+%%___Of̘aRՄ ׄ˒۷ok<y666:RIdd$$,, kkxc׸]>SGbc=DU% s~LQ~~~Zk˖-ܿl8!Ծ}{FQ5k#55U#XU&//J%#FsǙkIJҬ?`IMMs,]hܲiIII&\O?xC&%*L.Z2AU>!S &w̟?_O?_g}5/44ӧ4-- ___iڴ)|I>ӧO7|bJOOܹs={˗/ӤI^yjkJEڴi=YYY$%%ѧOQƭ}m2A'րOf9ɖ OJ>44?'P CE^/iiiXXXhÇ_4iWmT*y&۶mcرl߾VZl2nj3D,5z(QǭHzz:"##C{K/$bI$œMfcr.]ʚ5k4g3U/˗//' pЖ-[Y*ټ  1cx:i۶-#G4ɜ5_~5?++KӐ… >3gOVչzQAc֬Y)l׮ICtj1DP '<<ׯӢE zɬYٳ2Q󉎎68:4P=?maS666,\PҊ%R -DYAeIۅwɉ+WVݻ̜9˗ɓ'ythk=r-ULV˭[ի 0ɜDFff& 4?d *RXXQD Tݜmmmvbɒ%b# UdPgfwk6lM6eɒ%>ifffÀ*qF wiO:$j9Bzf[IHHɓ:u<nnnߖ=mڴ!99S\\LӦM] >cӿ#N{L+ k߿?Wfs=z@n;vsTGnn.NbذatѨs=|h9|2\t0p@pss=Y\\,ژ]v%99tnݺ%Cjj*~~~ oD1I1Cmhw5? М[UEeN";FZn' 6Q?.C ^zL:ըܽ{1cTW_8wk׮e___ߏ{6~]v|/fF$qg͚\f̘1bMLCJHT;- Sjd2Oٚrg6IRÇ?~/\@AAYYYzݗ۷IHH֭[rɡaÆ2|pkR3gΈVWUVt6'F||K/Ĝ9sj4W/1x:5Ub`0P+5lؐo@ݫ=gΜUoNrr2ҏ>౒iٲ^a6mĉ† t.Z~qssYf?S\\̒%KLꎮ&>>L,--ҥ (J"""tʸt ,К޳gO,X fQ!F$.+LZΖ[h:N:),,܉ڵK74h%Kؼy3鞐 x W+tЁ&MTzEa/c +N_SʖS\+44kg}e˖Y_& [QD @&wZAnݺJWرc̞=[XaIIIQ\W^kbYp!YYY?oZ'bnʤI2O073hݻ'#Qs8/..&00%Kh2Qm۶,_\5=XB jh!?֯_kw\\ޚB`}INN.0annnU×_~Ixx8&L/$11kã󚋈ڵkgբVZFk=*KFF~!w4,ӤI)2AyB⩥VV) s/" 6dҥZSsssoX`'.ܾ}kj;99[opsscͼkg}-**bL<5U$%%,ֽ{HOO|Vvvv4o\^Tۮ>**iӦqNX<"L.=E- ocܸqXB'3eΟ?ڤ$} -[dF~kРsaŊhт0fΜ/ uL[͝1vlQ.{H\\|999*Ν;\a۶m|G:=8=R‚`xbsJӲ23{-ѪU+̵k״[s)qss{?$66ϻvj\֭1brܹC͛ҬY3y2ʼn'vSNMl~_@޽֭hc?^Pcmm͞={Ύ]xb㧟~ĉ:ۥKV\hk-0B&=G$ As*7ow}u>88oorasƍٹsgegTعs'۷Ғ.]ʄ ػwIYj̲3ghlقaaa(J˭: U>R#%D֋V)53Q~}7oN8Haa![lmb/Z"##}6L:;;;Xn^^^^$&::Zo&EEET29 J>|8e K< *=h?E6#C)-^T{nynݺU5vvvF\\֬Y=z&((ӭ[79|0'Of޼yDDDhB/^K_RRRήQ]ŕK'\@]l^S,,,6m~~~ ^,:S|#rT;^OUh|;v젨뫫Φ$N<|wL<<&MbӦM5P&B,^ʑ#G0a^Ӷm[}Xh{FPw9{,yyyZ+**b֭?^_\G._\5Nwuu4`e'2 3;-52AH(qt12UVq ֮]&kZ"iٲ%o뭬4h "--Ǐs1;=z 0CѲeKCFJ,G=vF'Odd$d-,,?~,QQQ|7ɓ'a^Jqq1ܹӨ5`[S'b\r\z[[[QڹzޞiӦSJ 2AٗDNKLn*Qף {{{͛ǫʪU4ş)J8}4gϞ:SU...0qDp\x]vk.Ãhܸ1U# %;;[Fa ʽYBB?h |||%B`LjmyēEMj 1jʣGصk;w,T^6665zKBޣ 6Сq[JJJ~:;.\f͚iApvv6FLL5ty& 6D&|ϴie2w.l۾͛6}saϭ#2AIHٝ (`ף VVV 67r1j, JIDAT޽~ѣG3v Yx1j gggFzxxԩ- gggbcc#<<\ kkkZnM֭iӦ /"=N CwZ%%%k,Z/L8p^YXX0b{=SV+2AЭYByM 04k֌yɺutIi@^^;vxzzEƍ; @͛={ݻЈl∍Ν;䐓Crr2qqqdggTO||^ˋ/Vs}D233ٳgy'gϏݻu\E%XIH!ZjdV! l{=ҡCVXŋY~&:rssٶm OOOO<ɑ#G4;wouʕ+ܸqΝ;?wݻ-C زe eԕYjڶmӧիW"ή]_n"ڼys&O̐!CLy -tؔxjyD @& |)Ӈ޽{̦MtaݻW_}#GV:{,+W,3OOOQkcϞ=mGqm@GtԄ 螮^\\\NyŊ^;>MIIaǎ?~\kcƊ4mڔ'믛Qf}/9xD @&2\~trK‚aÆ1x`v͞={t =|szͨQׯ&'Nz\:714gV8.E&An$1ݻw׈XRR;v $$hggرc3fSdTJHT-52AV宨 w3L<#Go>:SZRXjժ:6mXXgѲ˲gJ%24-5 ;%%EhǬYoZT "$@.tmp" && \ chmod +x "$@.tmp" && \ mv "$@.tmp" "$@" CLEANFILES = \ $(bin_SCRIPTS) \ echo/server.scm echo/client.scm \ rrepl.scm \ rpc/server.scm rpc/client.scm \ sscp.scm guile-ssh-0.18.0/examples/README000066400000000000000000000033461471416131000162020ustar00rootroot00000000000000# -*- mode: org; -*- * Examples This directory includes an examples of programs that use Guile-SSH library to access SSH protocol. Executable =.scm= files are produced from =.scm.in= files during the build process. ** =sssh.scm= Scheme Secure Shell (SSSH) uses Guile-SSH API to implement basic SSH client functionality. *** Usage Please see #+BEGIN_EXAMPLE $ ./sssh.scm --help #+END_EXAMPLE for information about program usage. *** Examples #+BEGIN_EXAMPLE $ ./sssh.scm --identity=~/.ssh/id_rsa --user=avp localhost "uname -a" #+END_EXAMPLE ** =ssshd.scm= Scheme Secure Shell Daemon (SSSHD) uses Guile-SSH API to implement basic SSH server functionality. ** =echo= Echo client and server. ** =rrepl.scm= A demo program that allows to connect to a remote REPL (RREPL) server. Pass =--help= (or =-h=) flag to the program to get usage information. ** =rpc= RPC over an SSH tunnel. ** =sscp.scm= *** Usage #+BEGIN_EXAMPLE $ sscp avp@127.0.0.1:/etc/profile profile #+END_EXAMPLE ** =pg-tunnel.scm= An example of using Guile-SSH tunnels and [[http://www.nongnu.org/guile-pg/][Guile-PG]] to access a remote PostgreSQL database. *** Usage Please see #+BEGIN_EXAMPLE $ ./pg-tunnel.scm --help #+END_EXAMPLE for information about program usage. *** Examples #+BEGIN_EXAMPLE $ ./pg-tunnel.scm --host=example.org --dbname=example --user=alice \ 'select * from people' #+END_EXAMPLE ** =uptop.scm= Connect to a remote host, execute =top= command on it and print the output in uppercase letters, with terminal control characters intact. The program shows usage of remote pipes (from =(ssh popen)= module.) *** Usage #+BEGIN_EXAMPLE ./uptop.scm #+END_EXAMPLE The program can be stopped by hitting Ctrl-C. guile-ssh-0.18.0/examples/README.org000077700000000000000000000000001471416131000176352READMEustar00rootroot00000000000000guile-ssh-0.18.0/examples/echo/000077500000000000000000000000001471416131000162325ustar00rootroot00000000000000guile-ssh-0.18.0/examples/echo/client.scm.in000066400000000000000000000110651471416131000206240ustar00rootroot00000000000000#!@GUILE@ \ --debug -e main # aside from this initial boilerplate, this is actually -*- scheme -*- code !# ;;; client.scm -- Echo client example. ;; Copyright (C) 2014, 2015 Artyom V. Poptsov ;; ;; 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 3 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, see ;; . ;;; Commentary: ;; Echo client example. ;; ;; Usage: client.scm [ options ] ;; ;; Options: ;; --user=, -u User name ;; --port=, -p Port number ;; --identity-file=, -i Path to private key ;; ;; Examples: ;; $ ./client.scm -i ~/.ssh/id_rsa -p 12345 127.0.0.1 "`date`" ;;; Code: (use-modules (ice-9 getopt-long) (ice-9 rdelim) (ssh channel) (ssh session) (ssh auth) (ssh key)) (define *program-name* "client.scm") (define *default-identity-file* (format #f "~a/.ssh/id_rsa" (getenv "HOME"))) (define *default-user* (getenv "USER")) (define *default-port* "22") ;; Command line options (define *option-spec* '((user (single-char #\u) (value #t)) (port (single-char #\p) (value #t)) (identity-file (single-char #\i) (value #t)) (help (single-char #\h) (value #f)))) (define (print-help-and-exit) "Print information about program usage." (display (string-append "\ " *program-name* " -- Echo client example. Copyright (C) Artyom V. Poptsov Licensed under GNU GPLv3+ Usage: " *program-name* " [ options ] Options: --user=, -u User name --port=, -p Port number --identity-file=, -i Path to private key ")) (exit 0)) (define (handle-error session) "Handle a SSH error." (display (get-error session)) (newline) (exit 1)) (define (get-prvkey session identity-file) "Get a private SSH key. Handle possible errors." (let ((prvkey (private-key-from-file identity-file))) (or prvkey (handle-error session)) prvkey)) (define (read-all port) "Read all lines from the PORT." (let r ((res (read-line port 'concat)) (str "")) (if (not (eof-object? str)) (r (string-append res str) (read-line port 'concat)) res))) (define (main args) "Entry point of the program." (let* ((options (getopt-long args *option-spec*)) (user (option-ref options 'user *default-user*)) (port (option-ref options 'port *default-port*)) (identity-file (option-ref options 'identity-file *default-identity-file*)) (help-needed? (option-ref options 'help #f)) (args (option-ref options '() #f))) (and (or (null? args) help-needed?) (print-help-and-exit)) (let* ((host (car args)) (str (cadr args)) (session (make-session #:user user #:host host #:port (string->number port) #:log-verbosity 'nolog))) ;Be quiet (connect! session) (case (authenticate-server session) ((not-known) (let* ((pubkey (get-server-public-key session)) (hash (get-public-key-hash pubkey 'md5))) (display "The server is unknown. Please check MD5 sum:\n") (format #t " ~a~%" (bytevector->hex-string hash))))) (let ((private-key (get-prvkey session identity-file))) (and (eqv? (userauth-public-key! session private-key) 'error) (handle-error session)) (let ((channel (make-channel session))) (or channel (handle-error session)) (channel-open-session channel) (write-line str channel) (let poll ((ready? #f)) (if ready? (format #t "Response from server: ~a~%" (read-all channel)) (poll (char-ready? channel)))) (close channel)))))) ;;; echo.scm ends here. guile-ssh-0.18.0/examples/echo/server.scm.in000066400000000000000000000173421471416131000206600ustar00rootroot00000000000000#!@GUILE@ \ --debug -e main -s # aside from this initial boilerplate, this is actually -*- scheme -*- code !# ;;; client.scm -- Echo server example. ;; Copyright (C) 2014, 2015 Artyom V. Poptsov ;; ;; 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 3 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, see ;; . ;;; Commentary: ;; Echo server example. ;; ;; Usage: server.scm ;; ;; Server listens incoming connections on the port 12345. ;;; Code: (use-modules (ice-9 rdelim) (ice-9 popen) (ice-9 getopt-long) (ssh server) (ssh message) (ssh session) (ssh channel) (ssh key) (ssh auth)) ; userauth-* (define *default-bindport* "12345") (define *default-log-verbosity* 'nolog) (define *default-rsakey* (format #f "~a/.ssh/id_rsa" (getenv "HOME"))) (define *default-dsakey* (format #f "~a/.ssh/id_dsa" (getenv "HOME"))) (define (handle-req-auth session msg msg-type) (let ((subtype (cadr msg-type))) (format #t " subtype: ~a~%" subtype) ;; Allowed authentication methods (message-auth-set-methods! msg '(public-key)) (case subtype ((auth-method-publickey) (let* ((req (message-get-req msg)) (user (auth-req:user req)) (pubkey (auth-req:pubkey req)) (pubkey-state (auth-req:pubkey-state req))) (format #t (string-append " User ~a wants to authenticate with a public key (~a)~%" " Public key state: ~a~%") user (get-key-type pubkey) pubkey-state) (case pubkey-state ((none) (message-auth-reply-public-key-ok msg)) ((valid) (message-reply-success msg)) (else (format #t " Bad public key state: ~a~%" pubkey-state) (message-reply-default msg))))) (else (message-reply-default msg))))) (define (handle-req-channel-open msg msg-type) (let ((subtype (cadr msg-type))) (format #t " subtype: ~a~%" subtype) (case subtype ((channel-session) (message-channel-request-open-reply-accept msg)) (else (message-reply-default msg) #f)))) (define (handle-req-channel msg msg-type channel) (let ((subtype (cadr msg-type))) (format #t " subtype: ~a~%" subtype) (case subtype ((channel-request-env) (let* ((env-req (message-get-req msg)) (name (env-req:name env-req)) (value (env-req:value env-req))) (format #t (string-append " env requested:~%" " name: ~a~%" " value: ~a~%") name value) (setenv name value) (message-reply-success msg))) (else (message-reply-success msg))))) (define (read-all port) "Read all lines from the PORT." (let r ((res (read-line port 'concat)) (str "")) (if (and (not (eof-object? str)) (char-ready? port)) (r (string-append res str) (read-line port 'concat)) res))) (define (print-help-and-exit) "Print help message and exit." (display "\ Usage: server.scm [ options ] Options: --rsakey=, -r Set host RSA key. --dsakey=, -d Set host DSA key. --port=, -p Set bind port of the server. --help, -h Print this message and exit. ") (exit 0)) (define *option-spec* '((dsakey (single-char #\d) (value #t)) (rsakey (single-char #\r) (value #t)) (port (single-char #\p) (value #t)) (help (single-char #\h) (value #f)))) (define (main args) "Entry point of the program." (let* ((options (getopt-long args *option-spec*)) (dsakey (option-ref options 'dsakey *default-dsakey*)) (rsakey (option-ref options 'rsakey *default-rsakey*)) (port (option-ref options 'port *default-bindport*)) (help-wanted (option-ref options 'help #f))) (and help-wanted (print-help-and-exit)) (let ((server (make-server #:bindport (string->number port) #:rsakey rsakey #:dsakey dsakey #:log-verbosity *default-log-verbosity* #:banner "Scheme Secure Shell Daemon")) (channel #f)) (format #t (string-append "Using RSA key ~a~%" "Using DSA key ~a~%" "Listening on port ~a~%") rsakey dsakey port) ;; Start listen to incoming connections. (server-listen server) (while #t ;; Accept new connections from clients. Every connection is ;; handled in its own SSH session. (let ((session (catch 'guile-ssh-error (lambda () (server-accept server)) (lambda (key . args) (format #t "~a: ~a~%" key args) #f)))) (if (not session) (begin (sleep 1) (continue))) (display "Client accepted.\n") (server-handle-key-exchange session) ;; Handle messages from the connected SSH client. (let session-loop ((msg (server-message-get session))) (if msg (let ((msg-type (message-get-type msg))) (format #t "Message: ~a~%" msg-type) ;; Check the type of the message (case (car msg-type) ((request-service) (let ((srv-req (message-get-req msg))) (format #t " Service requested: ~a~%" (service-req:service srv-req)) (message-reply-success msg))) ((request-auth) (handle-req-auth session msg msg-type)) ((request-channel-open) (set! channel (handle-req-channel-open msg msg-type)) (let poll ((ready? #f)) (if ready? (catch 'guile-ssh-error (lambda () (let ((str (read-all channel))) (format #t "Received message: ~a~%" str) (display "Echoing back...\n") (write-line str channel))) (lambda (key . args) (display "error\n") (display (get-error session)))) (poll (char-ready? channel)))) (close channel)) ((request-channel) (handle-req-channel msg msg-type channel)) (else (display "Reply default\n") (message-reply-default msg))))) (if (connected? session) (session-loop (server-message-get session)))) (disconnect! session)))))) ;;; server.scm ends here. guile-ssh-0.18.0/examples/pg-tunnel.scm.in000077500000000000000000000105661471416131000203510ustar00rootroot00000000000000#!@GUILE@ \ --debug -e main !# ;;; pg-tunnel.scm -- Connect to a PostgreSQL instance through an SSH tunnel. ;; Copyright (C) 2015 Artyom V. Poptsov ;; ;; 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 3 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, see . ;;; Commentary: ;; An example of using Guile-SSH [1] tunnels and Guile-PG [2] to access a ;; remote PostgreSQL database. ;; ;; This program is known to work with the 'master' branch of Guile-SSH, commit ;; '1673d06'. ;; ;; Example: ;; ./pg-tunnel.scm --host=example.org --dbname=example --user=alice \ ;; 'select * from people' ;; ;; References: ;; ;; [1] https://github.com/artyom-poptsov/guile-ssh ;; [2] http://www.nongnu.org/guile-pg/ ;;; Code: (use-modules (ice-9 getopt-long) ;; PostgreSQL adapter from Guile-PG (database postgres) ;; Guile-SSH (ssh session) (ssh auth) (ssh tunnel)) (setlocale LC_ALL "") (define *mtx* (make-mutex 'allow-external-unlock 'unchecked-unlock)) (lock-mutex *mtx* 0 #f) (define (start-postgres-tunnel host) "Start an SSH tunnel to a postgres server running on a HOST." (let ((session (make-session #:host host #:config #t))) (connect! session) (format #t "Session with a server: ~a~%" session) (authenticate-server session) (userauth-agent! session) (let ((tunnel (make-tunnel session #:host "localhost" #:port 5432))) (format #t "Starting the tunnel ~a ...~%" tunnel) (unlock-mutex *mtx*) (start-forward tunnel)))) ;;; Helper procedures for processing of a result of a query ;; Taken from Guile-PG tutorial ;; (define (field-names result) (map (lambda (field) (pg-fname result field)) (iota (pg-nfields result)))) (define (get-values result tuple) (map (lambda (field) (pg-getvalue result tuple field)) (iota (pg-nfields result)))) (define (tuple->alist result tuple) (map (lambda (n v) (cons (string->symbol n) v)) (field-names result) (get-values result tuple))) ;;; (define (print-help-and-exit) (display "\ Usage: pg-tunnel [options] query Options: --host Name of the host on which DB is running. --dbname Name of a database. --user Database user name. --help Print this message and exit. Example: ./pg-tunnel.scm --host=example.org --dbname=example --user=alice \\ 'select * from people' ") (exit 0)) (define (main args) "Entry point." (let* ((option-spec '((host (value #t) (required? #t)) (dbname (value #t) (required? #t)) (user (value #t) (required? #t)) (help (value #f)))) (options (getopt-long args option-spec)) (dbname (option-ref options 'dbname #f)) (user (option-ref options 'user #f)) (host (option-ref options 'host #f)) (help-needed? (option-ref options 'help #f)) (args (option-ref options '() #f)) ;; Start an SSH tunnel. (thread (call-with-new-thread (lambda () (start-postgres-tunnel host))))) (and (or help-needed? (null? args)) (print-help-and-exit)) ;; Wait for tunnel to be established. (lock-mutex *mtx*) (let ((db (pg-connectdb (format #f "dbname=~a user=~a host=localhost port=5432" dbname user)))) (format #t "DB connection created: ~a~%" db) (format #t "Query: ~a~%" args) (let ((result (pg-exec db (car args)))) (format #t "Response: ~a~%" (tuple->alist result 0)) (cancel-thread thread))))) ;;; pg-tunnel.scm ends here. guile-ssh-0.18.0/examples/rpc/000077500000000000000000000000001471416131000161005ustar00rootroot00000000000000guile-ssh-0.18.0/examples/rpc/client.scm.in000066400000000000000000000104671471416131000204770ustar00rootroot00000000000000#!@GUILE@ \ -e main !# ;;; client.scm -- An example of an RPC call over a SSH tunnel. ;; Copyright (C) 2015 Artyom V. Poptsov ;; ;; 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 3 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, see ;; . ;;; Commentary: ;; A demo program that makes an RPC call over a SSH tunnel. For simplicity ;; the program uses ssh-agent for authentication. ;; ;; The basic code for the RPC call is taken from Guile-RPC documentation. ;;; Code: (use-modules (ice-9 getopt-long) ;; RPC (rpc rpc) (rpc xdr) (rpc xdr types) ;; Guile-SSH (ssh session) (ssh auth) (ssh tunnel)) (define result-type (make-xdr-struct-type (list xdr-integer ;; `integer_part' xdr-unsigned-integer))) ;; `decimal_part' (define invoke-split-number (make-synchronous-rpc-call 80000 0 ;; program and version 1 ;; procedure number xdr-double ;; argument type result-type)) (define (print-help-and-exit) "Print information about program usage." (display "\ Usage: rrepl.scm [options] Connect to a remote REPL (RREPL) using an ssh-agent for authentication. Options: --user, -u User name. --port, -p SSH port number (default: 22) --help, -h Print this message and exit. ") (exit)) (define (main args) "Entry point of the program." (let* ((options-spec '((user (single-char #\u) (value #t)) (port (single-char #\p) (value #t)) (local-port (single-char #\l) (value #t)) (help (single-char #\h) (value #f)))) (options (getopt-long args options-spec)) (user (option-ref options 'user (getenv "USER"))) (port (option-ref options 'port "22")) (local-port (option-ref options 'local-port "12345")) (help-needed? (option-ref options 'help #f)) (args (option-ref options '() #f))) (and (or help-needed? (not args) (null? args)) (print-help-and-exit)) (let ((pid (primitive-fork))) (if (zero? pid) ;; Make a new SSH session, connect it and authenticate the user. (let* ((host (car args)) (session (make-session #:user user #:host host #:port (string->number port) #:log-verbosity 'nolog))) (connect! session) (userauth-agent! session) ;; Make a new SSH tunnel. (let ((tunnel (make-tunnel session #:port (string->number local-port) ;; Guile-RPC server listens on localhost. #:host "127.0.0.1" ;; Guile-RPC server port. #:host-port 6666))) (start-forward tunnel))) (let ((sock (socket PF_INET SOCK_STREAM 0))) (dynamic-wind (const #t) (lambda () (sleep 1) (connect sock AF_INET (inet-pton AF_INET "127.0.0.1") (string->number local-port)) ;; Make an RPC call using the SSH tunnel. (display (invoke-split-number 3.14 #x7777 sock)) (newline)) (lambda () (close sock) (kill pid SIGTERM) (waitpid pid)))))))) ;;; client.scm ends here. guile-ssh-0.18.0/examples/rpc/server.scm.in000066400000000000000000000043571471416131000205300ustar00rootroot00000000000000#!@GUILE@ \ -e main !# ;;; server.scm -- An simple RPC server. ;; Copyright (C) 2015 Artyom V. Poptsov ;; ;; 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 3 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, see ;; . ;;; Commentary: ;; A simple RPC server. ;; ;; The code for the server is taken from Guile-RPC documentation. ;;; Code: ;; Taken from Guile-RPC examples. (use-modules (rpc rpc server) (rpc xdr) (rpc xdr types)) (define (split-number-handler number) ;; Handle a `split-number' request. (let* ((int (floor number)) (dec (floor (* 1000 (- number int))))) (list (inexact->exact int) (inexact->exact dec)))) (define result-type (make-xdr-struct-type (list xdr-integer ;; `integer_part' xdr-unsigned-integer))) ;; `decimal_part' (define my-rpc-program ;; Define our RPC program. (let* ((proc (make-rpc-procedure 1 xdr-double result-type split-number-handler)) (version (make-rpc-program-version 0 (list proc)))) (make-rpc-program 80000 (list version)))) (define (main args) "Entry point of the program." (let ((server-socket (socket PF_INET SOCK_STREAM 0))) (bind server-socket AF_INET INADDR_LOOPBACK 6666) (listen server-socket 1024) ;; Go ahead and serve requests. (run-stream-rpc-server (list (cons server-socket my-rpc-program)) 1000000 ;; a one-second timeout #f ;; we don't care about closed connections (lambda () ;; our idle thunk (format #t "one second passed~%"))))) ;;; server.scm ends here. guile-ssh-0.18.0/examples/rrepl.scm.in000066400000000000000000000052071471416131000175550ustar00rootroot00000000000000#!@GUILE@ \ --debug -e main !# ;;; rrepl.scm -- An example of RREPL usage. ;; Copyright (C) 2015 Artyom V. Poptsov ;; ;; 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 3 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, see ;; . ;;; Commentary: ;; A demo program that connects to a remote REPL (RREPL). For simplicity the ;; program uses ssh-agent for authentication. ;;; Code: (use-modules (ice-9 getopt-long) (ssh session) (ssh auth) (ssh dist)) (define (print-help-and-exit) "Print information about program usage." (display "\ Usage: rrepl.scm [options] Connect to a remote REPL (RREPL) using an ssh-agent for authentication. Options: --user, -u User name. --port, -p SSH port number (default: 22) --repl-port, -P Gulie REPL port number (default: 37146) --help, -h Print this message and exit. ") (exit)) ;;; Entry point (define (main args) "Entry point of the program." (let* ((options-spec '((user (single-char #\u) (value #t)) (port (single-char #\p) (value #t)) (repl-port (single-char #\P) (value #t)) (help (single-char #\h) (value #f)))) (options (getopt-long args options-spec)) (user (option-ref options 'user (getenv "USER"))) (port (option-ref options 'port "22")) (repl-port (option-ref options 'repl-port "37146")) (help-needed? (option-ref options 'help #f)) (args (option-ref options '() #f))) (and (or help-needed? (not args) (null? args)) (print-help-and-exit)) (let* ((host (car args)) (s (make-session #:user user #:host host #:port (string->number port) #:log-verbosity 'nolog))) (connect! s) (userauth-agent! s) (rrepl (make-node s (string->number repl-port))) (exit 0)))) ;;; rrepl.scm ends here. guile-ssh-0.18.0/examples/sscp.scm.in000066400000000000000000000062151471416131000174010ustar00rootroot00000000000000#!@GUILE@ \ --debug -e main !# ;;; sscp.scm -- Scheme Secure Copy implementation. ;; Copyright (C) 2015 Artyom V. Poptsov ;; ;; 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 3 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, see . ;;; Commentary: ;; Somewhat a minimal implementation of scp (Secure Copy) in Scheme that is ;; aimed to show how one could use (ssh sftp) module from Guile-SSH to do such ;; a work. ;;; Code: (use-modules (ice-9 regex) ; 'make-regexp' etc (ice-9 rdelim) ; 'read-line', 'write-line' (ice-9 getopt-long) ; CLI options parsing ;; Guile-SSH modules (ssh session) ; Guile-SSH sessions (ssh auth) ; Authentication (ssh sftp)) ; SFTP client API (define (debug fmt . args) (format #t "DEBUG: ~a~%" (apply format #f fmt args))) (define (print-help-and-exit) (display " Usage: sscp source dest Example: sscp avp@127.0.0.1:/etc/profile profile ") (exit 0)) (define %remote-regex (make-regexp "(.*)@([0-9]+\\.[0-9]+\\.[0-9]\\.[0-9]+):(.*)")) (define (cp user host path destination) "Copy a file specified by a PATH from HOST to a local DESTINATION." (let ((session (make-session #:user user #:host host))) (connect! session) (userauth-agent! session) (let ((sftp-session (make-sftp-session session))) (let ((remote-file (sftp-open sftp-session path O_RDONLY)) (local-file (open-output-file destination))) (let copy ((line (read-line remote-file))) (unless (eof-object? line) (write-line line local-file) (copy (read-line remote-file)))))))) (define (main args) "Entry point." (let* ((option-spec '((help (single-char #\h) (value #f)))) (options (getopt-long args option-spec)) (help-needed? (option-ref options 'help #f)) (args (option-ref options '() #f))) (and help-needed? (print-help-and-exit)) (debug "program args: ~a" args) (let* ((source (car args)) (destination (cadr args))) (debug "source: ~a; dest: ~a" source destination) (cond ((regexp-exec %remote-regex source) => (lambda (match) (let ((user (match:substring match 1)) (host (match:substring match 2)) (path (match:substring match 3))) (debug "user: ~a; host: ~a; path: ~a" user host path) (cp user host path destination)))) (else (error "Not supported yet. :-/" args)))))) ;;; sscp.scm ends here. guile-ssh-0.18.0/examples/sssh.scm.in000066400000000000000000000173701471416131000174150ustar00rootroot00000000000000#!@GUILE@ \ --debug -e main # aside from this initial boilerplate, this is actually -*- scheme -*- code !# ;;; sssh.scm -- Scheme Secure Shell. ;; Copyright (C) 2013, 2014, 2015 Artyom V. Poptsov ;; ;; 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 3 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, see ;; . ;;; Commentary: ;; This program is aimed to demonstrate some features of Guile-SSH ;; library. See https://github.com/artyom-poptsov/guile-ssh ;;; Code: (use-modules (ice-9 getopt-long) (ice-9 rdelim) (ssh channel) (ssh session) (ssh auth) (ssh key) (ssh version)) ;;; Variables and constants (define *program-name* "sssh") (define *default-identity-file* (string-append (getenv "HOME") "/.ssh/id_rsa")) (define *default-log-verbosity* "nolog") (define %accepted-key-types "ssh-rsa,rsa-sha2-256,ssh-dss,ecdh-sha2-nistp256") (define debug? #f) ;; Command line options (define *option-spec* '((user (single-char #\u) (value #t)) (port (single-char #\p) (value #t)) (identity-file (single-char #\i) (value #t)) (help (single-char #\h) (value #f)) (version (single-char #\v) (value #f)) (debug (single-char #\d) (value #f)) (known-hosts-file (value #t)) (ssh-debug (value #t)))) ;;; Helper procedures (define (handle-error session) "Handle an SSH error; exit with an error code." (write-line (get-error session)) (exit 1)) (define (print-debug msg) "Print debug information" (if debug? (display msg))) (define (format-debug fmt . args) "Format a debug message." (if debug? (apply format #t fmt args))) (define (read-all port) "Read all lines from the PORT." (define (read-and-catch) (catch 'guile-ssh-error (lambda () (read-line port 'concat)) (lambda (key . args) (format (current-error-port) "~a: ~a~%" key args) #f))) (let r ((res "") (str (read-and-catch))) (if (and str (not (eof-object? str))) (r (string-append res str) (read-and-catch)) res))) ;;; Printing of various information (define (print-version-and-exit) "Print information about versions." (format #t "libssh version: ~a~%" (get-libssh-version)) (format #t "libguile-ssh version: ~a~%" (get-library-version)) (exit)) (define (print-help-and-exit) "Print information about program usage." (display (string-append *program-name* " -- Scheme Secure Shell Copyright (C) Artyom Poptsov Licensed under GNU GPLv3+ Usage: " *program-name* " [ -upidv ] Options: --user=, -u User name --port=, -p Port number --identity-file=, -i Path to private key --debug, -d Debug mode --ssh-debug= Debug libssh --version, -v Print version ")) (exit)) ;;; Entry point of the program (define (main args) (if (null? (cdr args)) (print-help-and-exit)) (let* ((options (getopt-long args *option-spec*)) (user (option-ref options 'user (getenv "USER"))) (port (string->number (option-ref options 'port "22"))) (identity-file (option-ref options 'identity-file *default-identity-file*)) (debug-needed? (option-ref options 'debug #f)) (ssh-debug (option-ref options 'ssh-debug *default-log-verbosity*)) (known-hosts-file (option-ref options 'known-hosts-file #f)) (help-needed? (option-ref options 'help #f)) (version-needed? (option-ref options 'version #f)) (args (option-ref options '() #f))) (set! debug? debug-needed?) (if help-needed? (print-help-and-exit)) (if version-needed? (print-version-and-exit)) (if (or (null? args) (null? (cdr args))) (print-help-and-exit)) (let ((host (car args)) (cmd (cadr args))) (print-debug "1. make-session (ssh_new)\n") (let ((session (make-session #:user user #:host host #:port port #:identity identity-file #:public-key-accepted-types %accepted-key-types #:log-verbosity (string->symbol ssh-debug)))) (and known-hosts-file (not (string-null? known-hosts-file)) (session-set! session 'knownhosts known-hosts-file)) (print-debug "3. connect! (ssh_connect_x)\n") (connect! session) (format-debug " Available authentication methods: ~a~%" (userauth-get-list session)) (print-debug "4. authenticate-server (ssh_is_server_known)\n") (when (and known-hosts-file (not (string-null? known-hosts-file))) (case (authenticate-server session) ((ok) (print-debug " ok\n")) ((not-known) (display " The server is unknown. Please check MD5.\n")))) (let* ((pubkey (get-server-public-key session)) (hash (get-public-key-hash pubkey 'md5))) (format-debug " MD5 hash: ~a~%" (bytevector->hex-string hash))) (print-debug "5. userauth-autopubkey!\n") (let ((res (userauth-public-key/auto! session))) (format-debug " result: ~a~%\n" res) (unless (equal? res 'success) (handle-error session))) (print-debug "6. make-channel (ssh_channel_new)\n") (let ((channel (make-channel session))) (format-debug " channel: ~a~%" channel) (unless channel (handle-error session)) (print-debug "7. channel-open-session (ssh_channel_open_session)\n") (catch #t (lambda () (channel-open-session channel)) (lambda (key . args) (display args) (newline))) (format-debug " channel: ~a~%" channel) (print-debug "8. channel-request-exec (ssh_channel_request_exec)\n") (channel-request-exec channel cmd) (case (channel-get-exit-status channel) ((0) (print-debug "9. channel-poll (ssh_channel_poll)\n") (let poll ((ready? (char-ready? channel))) (if ready? (begin (print-debug "10. channel-read (ssh_channel_read)\n") (display (read-all channel)) (newline)) (if (channel-open? channel) (poll (char-ready? channel)) (format (current-error-port) "Channel is closed: ~a~%" channel))))) (else => (lambda (status) (format #t "ERROR: Failed to execute command `~a' (exit status ~a)~%" cmd status)))) (close channel) (disconnect! session)))))) ;;; sssh.scm ends here guile-ssh-0.18.0/examples/ssshd.scm.in000066400000000000000000000272411471416131000175570ustar00rootroot00000000000000#!@GUILE@ \ --debug -e main -s # aside from this initial boilerplate, this is actually -*- scheme -*- code !# ;;; ssshd.scm -- Scheme Secure Shell Daemon. ;; Copyright (C) 2013-2024 Artyom V. Poptsov ;; ;; 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 3 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, see ;; . ;;; Commentary: ;; Scheme Secure Shell Daemon (SSHD) -- an ssh daemon written in GNU ;; Guile that uses Guile-SSH API. ;;; Code: (use-modules (ice-9 rdelim) (ice-9 popen) (ice-9 getopt-long) (ssh server) (ssh message) (ssh session) (ssh channel) (ssh key) (ssh auth) ; userauth-* (ssh version)) ;;; Variables and constants (define *default-bindport* "12345") (define *default-log-verbosity* "nolog") (define *default-rsakey* (format #f "~a/.ssh/id_rsa" (getenv "HOME"))) (define *default-dsakey* (format #f "~a/.ssh/id_dsa" (getenv "HOME"))) (define *default-pid-file* "ssshd.pid") (define debug? #t) ;;; Helper procedures (define (read-all port) "Read all lines from the PORT." (define (read-and-catch) (catch 'guile-ssh-error (lambda () (read-line port 'concat)) (lambda (key . args) (format (current-error-port) "~a: ~a~%" key args) #f))) (let r ((res "") (str (read-and-catch))) (if (and str (not (eof-object? str))) (r (string-append res str) (read-and-catch)) res))) ;;; Handlers (define (handle-channel channel) (let* ((data (read-all channel))) (format #t " data: ~a~%" data))) (define (handle-request-exec msg channel) "Handle a non-interactive SSH session" (let ((cmd (exec-req:cmd (message-get-req msg)))) (format #t " cmd: ~a~%" cmd) (let* ((port (open-input-pipe cmd)) (res (read-all port))) (if (string-null? res) (channel-request-send-exit-status channel 1) (channel-request-send-exit-status channel 0)) (display res channel)))) (define (handle-req-auth session msg msg-type) (let ((subtype (cadr msg-type))) (format #t " subtype: ~a~%" subtype) ;; Allowed authentication methods (message-auth-set-methods! msg '(public-key password)) (case subtype ((auth-method-publickey) (let* ((req (message-get-req msg)) (user (auth-req:user req)) (pubkey (auth-req:pubkey req)) (pubkey-state (auth-req:pubkey-state req))) (format #t (string-append " User ~a wants to authenticate with a public key (~a)~%" " Public key state: ~a~%") user (get-key-type pubkey) pubkey-state) (case pubkey-state ((none) (message-auth-reply-public-key-ok msg)) ((valid) (message-reply-success msg)) (else (format #t " Bad public key state: ~a~%" pubkey-state) (message-reply-default msg))))) ((auth-method-password) (let* ((req (message-get-req msg)) (user (auth-req:user req)) (pswd (auth-req:password req))) (format #t " User ~a wants to authenticate with a password~%" user) (if (string=? pswd "guile") (message-reply-success msg) (message-reply-default msg)))) ;; To enable authentication through the "none" method, we have ;; to call `message-auth-reply-success' procedure. ;; ;; The "none" method is disabled according to recommendations of ;; RFC4251. Here we return the list of available authentication ;; methods back to the client. ((auth-method-none) (message-reply-default msg)) (else (message-reply-default msg))))) (define (handle-req-channel-open msg msg-type) (let ((subtype (cadr msg-type))) (format #t " subtype: ~a~%" subtype) (case subtype ((channel-session) (message-channel-request-open-reply-accept msg)) (else (message-reply-default msg) #f)))) (define (shell-loop channel) (let ((cmd (read-all channel))) (format #t " ~a~%" cmd) (let* ((port (open-input-pipe cmd)) (res (read-all port))) (display channel res))) (if (channel-open? channel) (shell-loop channel))) (define (handle-req-channel msg msg-type channel) (let ((subtype (cadr msg-type))) (format #t " subtype: ~a~%" subtype) (case subtype ((channel-request-exec) (handle-request-exec msg channel) (message-reply-success msg)) ((channel-request-pty) (let ((pty-req (message-get-req msg))) (format #t (string-append " pty requested:~%" " Term: ~a~%" " Width: ~a~%" " Height: ~a~%") (pty-req:term pty-req) (pty-req:width pty-req) (pty-req:height pty-req)) (message-reply-success msg))) ((channel-request-env) (let* ((env-req (message-get-req msg)) (name (env-req:name env-req)) (value (env-req:value env-req))) (format #t (string-append " env requested:~%" " name: ~a~%" " value: ~a~%") name value) (setenv name value) (message-reply-success msg))) (else (message-reply-success msg))))) (define (close-ports) "Close default ports." (close-port (current-input-port)) (close-port (current-output-port)) (let ((p (open-output-file "/dev/null"))) (set-current-output-port p) (set-current-error-port p))) (define (print-help-and-exit) "Print help message and exit." (display (string-append "\ Usage: ssshd.scm [ options ] Options: --rsakey=, -r Set host RSA key. Default: " *default-rsakey* " --dsakey=, -d Set host DSA key. Default: " *default-dsakey* " --detach Detach mode --ssh-debug= Debug libssh --pid-file= File to store PID after the server starts to listen to the socket. Default: " *default-pid-file* " --port=, -p Port number --ssh-debug= Set the log verbosity (default: nolog) Allowed values: nolog, rare, protocol, packet, functions --help, -h Print this message and exit. ")) (exit)) ;;; Entry point of the program. (define *option-spec* '((rsakey (single-char #\r) (value #t)) (dsakey (single-char #\d) (value #t)) (detach (value #f)) (ssh-debug (value #t)) (pid-file (value #t)) (port (single-char #\p) (value #t)) (help (single-char #\h) (value #f)))) (define (main args) "Entry point of the program." (display "---------- ssshd ----------\n") (let* ((options (getopt-long args *option-spec*)) (rsakey (option-ref options 'rsakey *default-rsakey*)) (dsakey (option-ref options 'dsakey *default-dsakey*)) (detach-wanted (option-ref options 'detach #f)) (ssh-debug (option-ref options 'ssh-debug *default-log-verbosity*)) (pid-file (option-ref options 'pid-file *default-pid-file*)) (bindport (string->number (option-ref options 'port *default-bindport*))) (help-wanted (option-ref options 'help #f))) (if help-wanted (print-help-and-exit)) (let ((f format)) (f #t "Using private RSA key: ~a~%" rsakey) (f #t "Using private DSA key: ~a~%" dsakey) (f #t "Listening on port: ~a~%" bindport) (f #t "PID file: ~a~%" pid-file)) (if detach-wanted (let ((pid (primitive-fork))) (cond ((zero? pid) (close-ports) (setsid)) ((> pid 0) (exit)) (#t (display "Could not fork the processs\n" (current-error-port)) (exit 1))))) (let ((server (make-server #:bindport bindport #:rsakey rsakey #:dsakey (and (dsa-support?) dsakey) #:log-verbosity (string->symbol ssh-debug) #:banner "Scheme Secure Shell Daemon")) (channel #f)) (catch 'guile-ssh-error (lambda () ;; Start listen to incoming connections. (server-listen server)) (lambda (key . args) (format (current-error-port) "~a: ~a~%" key args) (exit 1))) ;; Write the PID to a file. (let ((p (open-output-file pid-file))) (write (getpid) p) (close p)) (while #t ;; Accept new connections from clients. Every connection is ;; handled in its own SSH session. (let ((session (catch 'guile-ssh-error (lambda () (server-accept server)) (lambda (key . args) (format (current-error-port) "~a: ~a~%" key args) #f)))) (if (not session) (begin (sleep 1) (continue))) (server-handle-key-exchange session) ;; Handle messages from the connected SSH client. (let session-loop ((msg (server-message-get session))) (display "Message received.\n") (if (not msg) (error (get-error session))) (let ((msg-type (message-get-type msg))) (format #t "Message type: ~a~%" msg-type) ;; Check the type of the message (case (car msg-type) ((request-service) (let ((srv-req (message-get-req msg))) (format #t " Service requested: ~a~%" (service-req:service srv-req)) (message-reply-success msg))) ((request-auth) (handle-req-auth session msg msg-type)) ((request-channel-open) (set! channel (handle-req-channel-open msg msg-type))) ((request-channel) (handle-req-channel msg msg-type channel) ;; FIXME: We currently support only one exec request per ;; a session. (if (eq? (cadr msg-type) 'channel-request-exec) (begin (close channel) (disconnect! session)))) (else (display "Send the default reply.\n") (message-reply-default msg)))) (display "Message is handled.\n") (if (connected? session) (session-loop (server-message-get session)))) (display "Disconnect the current session.\n") (disconnect! session) (display "Waiting for the next connection...\n")))))) ;;; ssshd.scm ends here guile-ssh-0.18.0/examples/uptop.scm.in000077500000000000000000000046771471416131000176150ustar00rootroot00000000000000#!@GUILE@ \ --debug -e main !# ;;; uptop.scm -- Uppercase top. ;; Copyright (C) 2016 Artyom V. Poptsov ;; ;; 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 3 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, see . ;;; Commentary: ;; Connect to a remote host, execute 'top' command on it and print the output ;; in uppercase letters. ;;; Code: (use-modules (srfi srfi-41) ; streams (ssh session) (ssh auth) (ssh popen) ; remote pipes (ssh channel)) ; channel-set-pty-size! (define (pipe->stream p) "Convert a pipe P to a SRFI-41 stream." (stream-let loop ((c (read-char p))) (if (eof-object? c) (begin (close-input-port p) stream-null) (stream-cons c (loop (read-char p)))))) (define (open-remote-input-pipe/pty* session command . args) "Open remote input pipe with PTY, run a COMMAND with ARGS." (define OPEN_PTY_READ (string-append OPEN_PTY OPEN_READ)) (let ((p (apply open-remote-pipe* session OPEN_PTY_READ command args))) (channel-set-pty-size! p 80 40) p)) (define char-upcase/skip-esc (let ((state 'regular-char)) (lambda (chr) "Return the uppercase character version of a CHR, skip therminal escape sequences." (cond ((char=? chr (integer->char 27)) (set! state 'escape-sequence) chr) ((char=? chr #\m) (if (equal? state 'escape-sequence) (begin (set! state 'regular-char) chr) (char-upcase chr))) (else (char-upcase chr)))))) ;;; (define (main args) "Entry point." (let ((s (make-session #:host (cadr args)))) (connect! s) (userauth-agent! s) (let ((rs (pipe->stream (open-remote-input-pipe/pty* s "top" "-u $USER")))) (stream-for-each display (stream-map char-upcase/skip-esc rs))))) ;;; uptop.scm ends here. guile-ssh-0.18.0/guix.scm000066400000000000000000000233101471416131000151550ustar00rootroot00000000000000;;; guix.scm -- GNU Guix package definition. ;; Copyright (C) 2022-2024 Artyom V. Poptsov ;; ;; This file is a part of Guile-SSH. ;; ;; Guile-SSH 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 3 of the ;; License, or (at your option) any later version. ;; ;; Guile-SSH 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 Guile-SSH. If not, see ;; . ;;; Commentary: ;; Use this file to build Guile-SSH with GNU Guix: ;; ;; guix build -f guix.scm ;; ;; By default Guile-SSH builds with libssh 0.10, but it is possible to switch ;; it to libssh 0.9 by exporting an environment variable: ;; ;; export GUILE_SSH_BUILD_WITH_LIBSSH_0_9=1 ;; guix build -f guix.scm ;;; Code: (use-modules (guix gexp) ((guix licenses) #:prefix license:) (guix packages) (guix git-download) (guix download) (guix utils) (guix build-system cmake) (guix build-system gnu) (gnu packages autotools) (gnu packages guile) (gnu packages ssh) (gnu packages compression) (gnu packages kerberos) (gnu packages gnupg) (gnu packages texinfo) (gnu packages python) (gnu packages pkg-config) (gnu packages base)) (define %source-dir (dirname (current-filename))) (define-public libssh10 (package (name "libssh") (version "0.10.0") (source (origin (method url-fetch) (uri (string-append "https://www.libssh.org/files/" (version-major+minor version) "/libssh-" version ".tar.xz")) (sha256 (base32 "0mqbmz97p6wcq3k3lllnw2khvr3db3n2va45nz88m0yd6k2mih8d")))) (build-system cmake-build-system) (outputs '("out" "debug")) (arguments '(#:configure-flags '("-DWITH_GCRYPT=ON") ;; TODO: Add 'CMockery' and '-DWITH_TESTING=ON' for the test suite. #:tests? #f)) (inputs (list zlib libgcrypt mit-krb5)) (synopsis "SSH client library") (description "libssh is a C library implementing the SSHv2 and SSHv1 protocol for client and server implementations. With libssh, you can remotely execute programs, transfer files, and use a secure and transparent tunnel for your remote applications.") (home-page "https://www.libssh.org") (license license:lgpl2.1+))) (define-public libssh8-0 (package (inherit libssh10) (name "libssh") (version "0.8.0") (source (origin (method url-fetch) (uri (string-append "https://www.libssh.org/files/" (version-major+minor version) "/libssh-" version ".tar.xz")) (sha256 (base32 "1amgzvabl835vvzyv08hr05ak2ksp4jncbfnm2i0ayspf3b5qdg0")))) (native-inputs (list python)))) (define-public libssh8-1 (package (inherit libssh10) (name "libssh") (version "0.8.1") (source (origin (method url-fetch) (uri (string-append "https://www.libssh.org/files/" (version-major+minor version) "/libssh-" version ".tar.xz")) (sha256 (base32 "090r1fq8p89rwfv2x3wji3kyz31bf0z9mlv6pq7nrr55niki4zyi")))) (native-inputs (list python)))) (define-public libssh8 (package (inherit libssh10) (name "libssh") (version "0.8.3") (source (origin (method url-fetch) (uri (string-append "https://www.libssh.org/files/" (version-major+minor version) "/libssh-" version ".tar.xz")) (sha256 (base32 "1l19pl0l8lp00a8yawvf2yp8xhb4fjgsdmvprv9qqdpj0vv32brh")))) )) (define-public libssh9 (package (inherit libssh) (name "libssh") (version "0.9.0") (source (origin (method url-fetch) (uri (string-append "https://www.libssh.org/files/" (version-major+minor version) "/libssh-" version ".tar.xz")) (sha256 (base32 "19f7h8s044pqfhfk35ky5lj4hvqhi2p2p46xkwbcsqz6jllkqc15")))))) (define-public libssh11 (package (inherit libssh) (name "libssh") (version "0.11.1") (source (origin (method url-fetch) (uri (string-append "https://www.libssh.org/files/" (version-major+minor version) "/libssh-" version ".tar.xz")) (sha256 (base32 "0y8v5ihrqnjxchvjhz8fcczndchaaxxim64bqm8q3q4i5v3xrdql")))))) (define-public guile-ssh (package (name "guile-ssh") (version "git") (home-page "https://github.com/artyom-poptsov/guile-ssh") (source (local-file %source-dir #:recursive? #t #:select? (git-predicate %source-dir))) (build-system gnu-build-system) (outputs '("out" "debug")) (arguments `(;; It makes no sense to build libguile-ssh.a. #:configure-flags '("--disable-static") #:phases (modify-phases %standard-phases (add-before 'build 'fix-libguile-ssh-file-name (lambda* (#:key outputs #:allow-other-keys) ;; Build and install libguile-ssh.so so that we can use ;; its absolute file name in .scm files, before we build ;; the .go files. (let* ((out (assoc-ref outputs "out")) (lib (string-append out "/lib"))) (invoke "make" "install" "-C" "libguile-ssh" "-j" (number->string (parallel-job-count))) (substitute* (find-files "." "\\.scm$") (("\"libguile-ssh\"") (string-append "\"" lib "/libguile-ssh\""))) #t))) ,@(if (%current-target-system) '() '((add-before 'check 'fix-guile-path (lambda* (#:key inputs #:allow-other-keys) (let ((guile (assoc-ref inputs "guile"))) (substitute* "tests/common.scm" (("/usr/bin/guile") (string-append guile "/bin/guile"))) #t))))) (add-after 'install 'remove-bin-directory (lambda* (#:key outputs #:allow-other-keys) (let* ((out (assoc-ref outputs "out")) (bin (string-append out "/bin")) (examples (string-append out "/share/guile-ssh/examples"))) (mkdir-p examples) (rename-file (string-append bin "/ssshd.scm") (string-append examples "/ssshd.scm")) (rename-file (string-append bin "/sssh.scm") (string-append examples "/sssh.scm")) (delete-file-recursively bin) #t)))))) (native-inputs (list autoconf automake libtool texinfo pkg-config which guile-3.0)) ;needed when cross-compiling. (inputs (list guile-3.0 libssh10 libgcrypt)) (synopsis "Guile bindings to libssh") (description "Guile-SSH is a library that provides access to the SSH protocol for programs written in GNU Guile interpreter. It is a wrapper to the underlying libssh library.") (license license:gpl3+))) (define-public guile-ssh/libssh8-0 (package (inherit guile-ssh) (name "guile-ssh") (inputs (modify-inputs (package-inputs guile-ssh) (replace "libssh" libssh8-0))))) (define-public guile-ssh/libssh8-1 (package (inherit guile-ssh) (name "guile-ssh") (inputs (modify-inputs (package-inputs guile-ssh) (replace "libssh" libssh8-1))))) (define-public guile-ssh/libssh8 (package (inherit guile-ssh) (name "guile-ssh") (inputs (modify-inputs (package-inputs guile-ssh) (replace "libssh" libssh8))))) (define-public guile-ssh/libssh9 (package (inherit guile-ssh) (name "guile-ssh") (inputs (modify-inputs (package-inputs guile-ssh) (replace "libssh" libssh9))))) (define-public guile-ssh/libssh11 (package (inherit guile-ssh) (name "guile-ssh") (inputs (modify-inputs (package-inputs guile-ssh) (replace "libssh" libssh11))))) (cond ((getenv "GUILE_SSH_BUILD_WITH_LIBSSH_0_8_0") guile-ssh/libssh8-0) ((getenv "GUILE_SSH_BUILD_WITH_LIBSSH_0_8_1") guile-ssh/libssh8-1) ((getenv "GUILE_SSH_BUILD_WITH_LIBSSH_0_8") guile-ssh/libssh8) ((getenv "GUILE_SSH_BUILD_WITH_LIBSSH_0_9") guile-ssh/libssh9) ((getenv "GUILE_SSH_BUILD_WITH_LIBSSH_0_11") guile-ssh/libssh11) (else guile-ssh)) ;;; guix.scm ends here. guile-ssh-0.18.0/libguile-ssh/000077500000000000000000000000001471416131000160655ustar00rootroot00000000000000guile-ssh-0.18.0/libguile-ssh/.gitignore000066400000000000000000000001571471416131000200600ustar00rootroot00000000000000# -*- shell-script -*- # Object files and libraries .deps .libs *.o *.lo *.la config.h config.h.in stamp-h1 guile-ssh-0.18.0/libguile-ssh/Makefile.am000066400000000000000000000050311471416131000201200ustar00rootroot00000000000000## Copyright (C) 2013-2023 Artyom V. Poptsov ## ## This file is part of Guile-SSH. ## ## Guile-SSH 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 3 of the ## License, or (at your option) any later version. ## ## Guile-SSH 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 Guile-SSH. If not, see . lib_LTLIBRARIES = libguile-ssh.la libguile_ssh_la_SOURCES = \ callbacks.c \ callbacks.h \ auth.c \ auth.h \ channel-func.c \ channel-func.h \ channel-type.c \ channel-type.h \ channel-main.c \ error.c \ error.h \ key-func.c \ key-func.h \ key-main.c \ key-type.c \ key-type.h \ session-func.c \ session-func.h \ session-type.c \ session-type.h \ session-main.c \ server-main.c \ server-func.c \ server-func.h \ server-type.c \ server-type.h \ message-type.c \ message-type.h \ message-func.c \ message-func.h \ message-main.c \ version.c \ threads.c \ threads.h \ common.c \ common.h \ log.c \ log.h \ sftp-session-type.c \ sftp-session-type.h \ sftp-session-main.c \ sftp-session-func.c \ sftp-session-func.h \ sftp-file-type.c \ sftp-file-type.h \ sftp-file-main.c \ sftp-dir-type.h \ sftp-dir-type.c \ sftp-dir-func.c \ sftp-dir-func.h \ sftp-dir-main.c BUILT_SOURCES = \ auth.x \ channel-func.x \ channel-type.x \ error.x \ key-func.x \ key-type.x \ log.x \ message-func.x \ message-type.x \ server-func.x \ server-type.x \ session-func.x \ session-type.x \ sftp-file-type.x \ sftp-dir-type.x \ sftp-dir-func.x \ sftp-session-func.x \ sftp-session-type.x \ version.x libguile_ssh_la_CPPFLAGS = $(CFLAGS) $(GUILE_CFLAGS) SSH_LD_FLAGS = -lssh if ! HAVE_LIBSSH_0_8 SSH_LD_FLAGS += -lssh_threads endif libguile_ssh_la_LDFLAGS = \ -module \ -no-undefined $(SSH_LD_FLAGS) \ -version-info $(LIBGUILE_SSH_INTERFACE) \ $(GUILE_LDFLAGS) AM_CFLAGS = $(WARN_CFLAGS) AM_CPPFLAGS = -I$(top_srcdir)/libguile-ssh -I$(top_builddir)/libguile-ssh snarfcppopts = $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS) $(GUILE_CFLAGS) \ $(AM_CPPFLAGS) SUFFIXES = .x .c.x: $(AM_V_GEN)CPP="$(CPP)" $(guile_snarf) -o $@ $< $(snarfcppopts) CLEANFILES = *.x ## Makefile.am ends here guile-ssh-0.18.0/libguile-ssh/auth.c000066400000000000000000000231341471416131000171750ustar00rootroot00000000000000/* auth.c -- User authentication procedures. * * Copyright (C) 2013-2021 Artyom V. Poptsov * * This file is part of Guile-SSH. * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #include #include #include #include #include "error.h" #include "session-type.h" #include "key-type.h" #include "key-func.h" #include "log.h" /* On the username: Some libssh functions (such as `ssh_userauth_password') expect username as one of the parameters. But according to libssh 0.6 docs, most server implementations do not permit changing the username during authentication. Moreover, in some cases username parameter is already marked as deprecated in libssh 0.5.3. So I decided to simplify the Guile-SSH Auth API and eliminate username from parameter list of functions of this module. The username must be set by `session-set!' call. - avp */ /** * Convert SSH authentication result to a Scheme symbol * * Return a symbol. * * Throws: * 'guile-ssh-error' on an error. * * Aseerts: * - 'res' is a valid libssh authentication result. */ static SCM ssh_auth_result_to_symbol (const int res) { switch (res) { case SSH_AUTH_SUCCESS: return scm_from_locale_symbol ("success"); case SSH_AUTH_ERROR: return scm_from_locale_symbol ("error"); case SSH_AUTH_DENIED: return scm_from_locale_symbol ("denied"); case SSH_AUTH_PARTIAL: return scm_from_locale_symbol ("partial"); case SSH_AUTH_AGAIN: return scm_from_locale_symbol ("again"); default: /* Must not happen. */ _gssh_log_error_format(__func__, SCM_BOOL_F, "Unknown SSH result: %d", res); assert (0); guile_ssh_error1(__func__, "Unknown SSH result", scm_from_int (res)); return SCM_BOOL_F; } } SCM_DEFINE (guile_ssh_userauth_public_key_x, "userauth-public-key!", 2, 0, 0, (SCM session_smob, SCM private_key_smob), "Try to authenticate with a public key.\n" "Throw `wrong-type-arg' if a disconnected SESSION is passed\n" "as an argument.") #define FUNC_NAME s_guile_ssh_userauth_public_key_x { gssh_session_t *session_data = gssh_session_from_scm (session_smob); gssh_key_t *private_key_data = gssh_key_from_scm (private_key_smob); int res; GSSH_VALIDATE_CONNECTED_SESSION (session_data, session_smob, SCM_ARG1); SCM_ASSERT (_private_key_p (private_key_data), private_key_smob, SCM_ARG2, FUNC_NAME); res = ssh_userauth_publickey (session_data->ssh_session, NULL, /* username */ private_key_data->ssh_key); return ssh_auth_result_to_symbol (res); } #undef FUNC_NAME SCM_DEFINE (guile_ssh_userauth_public_key_auto_x, "userauth-public-key/auto!", 1, 0, 0, (SCM session), "Try to automatically authenticate with \"none\" method first\n" "and then with public keys. If the key is encrypted the user\n" "will be asked for a passphrase. Return one of the following \n" "symbols: error, denied, partial, success.\n" "Throw `wrong-type-arg' if a disconnected SESSION is passed\n" "as an argument.") #define FUNC_NAME s_guile_ssh_userauth_public_key_auto_x { gssh_session_t *sd = gssh_session_from_scm (session); GSSH_VALIDATE_CONNECTED_SESSION (sd, session, SCM_ARG1); int res = ssh_userauth_publickey_auto (sd->ssh_session, NULL, /* username */ NULL); /* passphrase */ return ssh_auth_result_to_symbol (res); } #undef FUNC_NAME SCM_DEFINE (guile_ssh_userauth_public_key_try, "userauth-public-key/try", 2, 0, 0, (SCM session, SCM public_key), "Throw `wrong-type-arg' if a disconnected SESSION is passed\n" "as an argument.") #define FUNC_NAME s_guile_ssh_userauth_public_key_try { gssh_session_t *sd = gssh_session_from_scm (session); gssh_key_t *kd = gssh_key_from_scm (public_key); int res; GSSH_VALIDATE_CONNECTED_SESSION (sd, session, SCM_ARG1); SCM_ASSERT (_public_key_p (kd), public_key, SCM_ARG2, FUNC_NAME); if (! ssh_is_connected (sd->ssh_session)) guile_ssh_error1 (FUNC_NAME, "Session is not connected", session); res = ssh_userauth_try_publickey (sd->ssh_session, NULL, /* username */ kd->ssh_key); return ssh_auth_result_to_symbol (res); } #undef FUNC_NAME SCM_DEFINE (guile_ssh_userauth_agent_x, "userauth-agent!", 1, 0, 0, (SCM session), "Throw `wrong-type-arg' if a disconnected SESSION is passed" " as an argument.") #define FUNC_NAME s_guile_ssh_userauth_agent_x { gssh_session_t *sd = gssh_session_from_scm (session); int res; GSSH_VALIDATE_CONNECTED_SESSION (sd, session, SCM_ARG1); res = ssh_userauth_agent (sd->ssh_session, NULL /* username */ ); return ssh_auth_result_to_symbol (res); } #undef FUNC_NAME /* Try to authenticate by password. */ SCM_DEFINE (guile_ssh_userauth_password_x, "userauth-password!", 2, 0, 0, (SCM session, SCM password), "Try to authenticate by password.\n" "Throw `wrong-type-arg' if a disconnected SESSION is passed" " as an argument.") #define FUNC_NAME s_guile_ssh_userauth_password_x { gssh_session_t* session_data = gssh_session_from_scm (session); char *c_password; int res; scm_dynwind_begin (0); /* Check types. */ GSSH_VALIDATE_CONNECTED_SESSION (session_data, session, SCM_ARG1); SCM_ASSERT (scm_is_string (password), password, SCM_ARG2, FUNC_NAME); c_password = scm_to_locale_string (password); scm_dynwind_free (c_password); res = ssh_userauth_password (session_data->ssh_session, NULL, /* username */ c_password); scm_dynwind_end (); return ssh_auth_result_to_symbol (res); } #undef FUNC_NAME SCM_DEFINE (guile_ssh_userauth_gssapi_x, "userauth-gssapi!", 1, 0, 0, (SCM session), "Try to authenticate through the \"gssapi-with-mic\" method." "Throw `wrong-type-arg' if a disconnected SESSION is passed" " as an argument.") #define FUNC_NAME s_guile_ssh_userauth_gssapi_x { gssh_session_t *sd = gssh_session_from_scm (session); int res; GSSH_VALIDATE_CONNECTED_SESSION (sd, session, SCM_ARG1); res = ssh_userauth_gssapi (sd->ssh_session); return ssh_auth_result_to_symbol (res); } #undef FUNC_NAME /* Try to authenticate through the "none" method. Return one of the following symbols: 'success, 'error, 'denied, 'partial, 'again */ SCM_DEFINE (guile_ssh_userauth_none_x, "userauth-none!", 1, 0, 0, (SCM arg1), "Try to authenticate through the \"none\" method.\n" "Throw `wrong-type-arg' if a disconnected SESSION is passed" " as an argument.") #define FUNC_NAME s_guile_ssh_userauth_none_x { gssh_session_t *session_data = gssh_session_from_scm (arg1); int res; GSSH_VALIDATE_CONNECTED_SESSION (session_data, arg1, SCM_ARG1); res = ssh_userauth_none (session_data->ssh_session, NULL /* username */ ); return ssh_auth_result_to_symbol (res); } #undef FUNC_NAME /* Get available authentication methods for a session SESSION_SMOB. Return list of available methods. */ SCM_DEFINE (guile_ssh_userauth_get_list, "userauth-get-list", 1, 0, 0, (SCM session), "Get available authentication methods for a session SESSION.\n" "Throw `wrong-type-arg' if a disconnected SESSION is passed " " as an argument.") #define FUNC_NAME s_guile_ssh_userauth_get_list { gssh_session_t *session_data = gssh_session_from_scm (session); SCM auth_list = SCM_EOL; int res; GSSH_VALIDATE_CONNECTED_SESSION (session_data, session, SCM_ARG1); res = ssh_userauth_list (session_data->ssh_session, NULL /* username */ ); if (res & SSH_AUTH_METHOD_PASSWORD) { SCM method = scm_from_locale_symbol ("password"); auth_list = scm_append (scm_list_2 (auth_list, scm_list_1 (method))); } if (res & SSH_AUTH_METHOD_PUBLICKEY) { SCM method = scm_from_locale_symbol ("public-key"); auth_list = scm_append (scm_list_2 (auth_list, scm_list_1 (method))); } if (res & SSH_AUTH_METHOD_HOSTBASED) { SCM method = scm_from_locale_symbol ("host-based"); auth_list = scm_append (scm_list_2 (auth_list, scm_list_1 (method))); } if (res & SSH_AUTH_METHOD_INTERACTIVE) { SCM method = scm_from_locale_symbol ("interactive"); auth_list = scm_append (scm_list_2 (auth_list, scm_list_1 (method))); } return auth_list; } #undef FUNC_NAME /* Initialization */ void init_auth_func (void) { #include "auth.x" } /* auth.c ends here */ guile-ssh-0.18.0/libguile-ssh/auth.h000066400000000000000000000024151471416131000172010ustar00rootroot00000000000000/* Copyright (C) 2013, 2014 Artyom V. Poptsov * * This file is part of Guile-SSH. * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #ifndef __AUTH_H__ #define __AUTH_H__ extern SCM guile_ssh_userauth_public_key_x (SCM arg1, SCM arg2); extern SCM guile_ssh_userauth_public_key_auto_x (SCM arg1); extern SCM guile_ssh_userauth_public_key_try (SCM arg1, SCM arg2); extern SCM guile_ssh_userauth_agent_x (SCM arg1); extern SCM guile_ssh_userauth_password_x (SCM arg1, SCM arg2); extern SCM guile_ssh_userauth_none_x (SCM arg1); extern SCM guile_ssh_userauth_get_list (SCM arg1); extern void init_auth_func (void); #endif /* ifndef __AUTH_H__ */ /* auth.h ends here */ guile-ssh-0.18.0/libguile-ssh/callbacks.c000066400000000000000000000041371471416131000201550ustar00rootroot00000000000000/* Copyright (C) 2023 Artyom V. Poptsov * * This file is part of Guile-SSH. * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #include #include #include "error.h" const char* CALLBACK_USER_DATA_NAME = "user-data"; /* Predicate. Return 1 if X is a Scheme procedure, 0 otherwise. */ static inline int scm_is_procedure (SCM x) { return scm_to_bool (scm_procedure_p (x)); } /* Callbacks. */ /* Predicate. Check if a callback NAME is present in CALLBACKS alist; return 1 if it is, 0 otherwise. */ int callback_set_p (SCM callbacks, const char* name) { return scm_is_true (scm_assoc (scm_from_locale_symbol (name), callbacks)); } /* Get an element NAME of the callbacks alist from a session data SD. */ SCM callback_ref (SCM callbacks, const char* name) { return scm_assoc_ref (callbacks, scm_from_locale_symbol (name)); } /* Validate callback NAME. Throw 'guile-ssh-error' exception on an error. */ void callback_validate (SCM parent, SCM callbacks, const char* name) { if (! scm_is_procedure (callback_ref (callbacks, name))) { enum { BUFSZ = 70 }; char msg[BUFSZ]; snprintf (msg, BUFSZ, "'%s' must be a procedure", name); guile_ssh_error1 ("callback_validate", msg, scm_list_2 (parent, callbacks)); } } SCM callback_userdata_ref (SCM callbacks) { return callback_ref (callbacks, CALLBACK_USER_DATA_NAME); } /* callbacks.c ends here. */ guile-ssh-0.18.0/libguile-ssh/callbacks.h000066400000000000000000000020671471416131000201620ustar00rootroot00000000000000/* Copyright (C) 2023 Artyom V. Poptsov * * This file is part of Guile-SSH. * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #ifndef __CALLBACKS_H__ #define __CALLBACKS_H__ int callback_set_p (SCM callbacks, const char* name); SCM callback_ref (SCM callbacks, const char* name); void callback_validate (SCM parent, SCM callbacks, const char* name); SCM callback_userdata_ref (SCM callbacks); #endif /* __CALLBACKS_H__ */ /* callbacks.h ends here. */ guile-ssh-0.18.0/libguile-ssh/channel-func.c000066400000000000000000000504261471416131000206010ustar00rootroot00000000000000/* channel-func.c -- SSH channel manipulation functions. * * Copyright (C) 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Artyom V. Poptsov * * This file is part of Guile-SSH. * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #include #include #include #include #include #include "common.h" #include "log.h" #include "error.h" #include "channel-type.h" #include "session-type.h" #ifdef HAVE_LIBSSH_0_7_3 #define ssh_forward_listen ssh_channel_listen_forward #define ssh_forward_cancel ssh_channel_cancel_forward #endif /* Allocate a new SSH channel. */ SCM_DEFINE_N (guile_ssh_make_channel, "%make-channel", 2, (SCM arg1, SCM flags), "\ Allocate a new SSH channel.\ ") #define FUNC_NAME s_guile_ssh_make_channel { gssh_session_t *session_data = gssh_session_from_scm (arg1); ssh_channel ch; GSSH_VALIDATE_CONNECTED_SESSION (session_data, arg1, SCM_ARG1); SCM_ASSERT (scm_is_integer (flags), flags, SCM_ARG2, FUNC_NAME); ch = ssh_channel_new (session_data->ssh_session); if (! ch) return SCM_BOOL_F; SCM channel = ssh_channel_to_scm (ch, arg1, scm_to_long (flags)); gssh_session_add_channel_x (session_data, channel); return channel; } #undef FUNC_NAME SCM_DEFINE_1 (guile_ssh_is_channel_p, "channel?", (SCM x), "\ Return #t if X is a SSH channel, #f otherwise.\ ") { #if USING_GUILE_BEFORE_2_2 return scm_from_bool (SCM_SMOB_PREDICATE (channel_tag, x)); #else return scm_from_bool (SCM_PORTP (x) && SCM_PORT_TYPE (x) == channel_tag); #endif } #if USING_GUILE_BEFORE_2_2 SCM equalp_channel (SCM x1, SCM x2) { return compare_objects(x1, x2, gssh_channel_from_scm); } #endif /* Procedures */ SCM_DEFINE_1 (guile_ssh_channel_open_session, "channel-open-session", (SCM channel), "\ Open a new session and mark the channel CHANNEL as opened port.\n\ Return value is undefined.\ ") #define FUNC_NAME s_guile_ssh_channel_open_session { gssh_channel_t *data = gssh_channel_from_scm (channel); int res; GSSH_VALIDATE_CHANNEL_DATA (data, channel, FUNC_NAME); if (! _gssh_channel_parent_session_connected_p (data)) guile_ssh_error1 (FUNC_NAME, "Parent session is not connected", channel); res = ssh_channel_open_session (data->ssh_channel); _gssh_log_debug_format(FUNC_NAME, channel, "result: %d", res); if (res != SSH_OK) { ssh_session session = ssh_channel_get_session (data->ssh_channel); guile_ssh_session_error1 (FUNC_NAME, session, channel); } SCM_SET_CELL_TYPE (channel, SCM_CELL_TYPE (channel) | SCM_OPN); return SCM_UNDEFINED; } #undef FUNC_NAME /* Run a shell command CMD without an interactive shell. */ SCM_DEFINE_N (guile_ssh_channel_request_exec, "channel-request-exec", 2, (SCM channel, SCM cmd), "\ Run a shell command CMD without an interactive shell.\ ") #define FUNC_NAME s_guile_ssh_channel_request_exec { gssh_channel_t *data = gssh_channel_from_scm (channel); int res; char *c_cmd; /* Command to execute. */ GSSH_VALIDATE_OPEN_CHANNEL (channel, SCM_ARG1, FUNC_NAME); SCM_ASSERT (scm_is_string (cmd), cmd, SCM_ARG2, FUNC_NAME); if (! _gssh_channel_parent_session_connected_p (data)) guile_ssh_error1 (FUNC_NAME, "Parent session is not connected", channel); c_cmd = scm_to_locale_string (cmd); res = ssh_channel_request_exec (data->ssh_channel, c_cmd); _gssh_log_debug_format(FUNC_NAME, scm_list_2 (channel, cmd), "result: %d", res); free (c_cmd); if (res != SSH_OK) { ssh_session session = ssh_channel_get_session (data->ssh_channel); guile_ssh_session_error1 (FUNC_NAME, session, scm_list_2 (channel, cmd)); } return SCM_UNDEFINED; } #undef FUNC_NAME SCM_DEFINE_1 (guile_ssh_channel_get_exit_status, "channel-get-exit-status", (SCM channel), "\ Get the exit status of the channel (error code from the executed \ instruction). Return the exist status, or #f if no exit status has been \ returned (yet). \ ") #define FUNC_NAME s_guile_ssh_channel_get_exit_status { gssh_channel_t *cd = NULL; int res; GSSH_VALIDATE_OPEN_CHANNEL (channel, SCM_ARG1, FUNC_NAME); cd = gssh_channel_from_scm (channel); if (! _gssh_channel_parent_session_connected_p (cd)) guile_ssh_error1 (FUNC_NAME, "Parent session is not connected", channel); res = ssh_channel_get_exit_status (cd->ssh_channel); _gssh_log_debug_format(FUNC_NAME, channel, "result: %d", res); if (res == SSH_ERROR) { _gssh_log_warning (FUNC_NAME, "Could not get exit status", channel); } return (res == SSH_ERROR) ? SCM_BOOL_F : scm_from_int (res); } #undef FUNC_NAME SCM_DEFINE_N (guile_ssh_channel_request_send_exit_status, "channel-request-send-exit-status", 2, (SCM channel, SCM exit_status), "\ Send the exit status to the remote process (as described in RFC 4254, section\n\ 6.10).\n\ Return value is undefined.\ ") #define FUNC_NAME s_guile_ssh_channel_request_send_exit_status { gssh_channel_t *cd = gssh_channel_from_scm (channel); int res; GSSH_VALIDATE_OPEN_CHANNEL (channel, SCM_ARG1, FUNC_NAME); SCM_ASSERT (scm_is_unsigned_integer (exit_status, 0, UINT32_MAX), exit_status, SCM_ARG2, FUNC_NAME); if (! _gssh_channel_parent_session_connected_p (cd)) guile_ssh_error1 (FUNC_NAME, "Parent session is not connected", channel); res = ssh_channel_request_send_exit_status (cd->ssh_channel, scm_to_uint32 (exit_status)); _gssh_log_debug_format(FUNC_NAME, scm_list_2 (channel, exit_status), "result: %d", res); if (res != SSH_OK) { ssh_session session = ssh_channel_get_session (cd->ssh_channel); guile_ssh_session_error1 (FUNC_NAME, session, channel); } return SCM_UNDEFINED; } #undef FUNC_NAME SCM_DEFINE_1 (guile_ssh_channel_request_pty, "channel-request-pty", (SCM channel), "\ Request a PTY (pseudo terminal).\n\ Return value is undefined.\ ") #define FUNC_NAME s_guile_ssh_channel_request_pty { gssh_channel_t *data = gssh_channel_from_scm (channel); int res; GSSH_VALIDATE_OPEN_CHANNEL (channel, SCM_ARG1, FUNC_NAME); if (! _gssh_channel_parent_session_connected_p (data)) guile_ssh_error1 (FUNC_NAME, "Parent session is not connected", channel); res = ssh_channel_request_pty (data->ssh_channel); _gssh_log_debug_format(FUNC_NAME, channel, "result: %d", res); if (res != SSH_OK) { ssh_session session = ssh_channel_get_session (data->ssh_channel); guile_ssh_session_error1 (FUNC_NAME, session, channel); } return SCM_UNDEFINED; } #undef FUNC_NAME SCM_DEFINE_1 (guile_ssh_channel_request_shell, "channel-request-shell", (SCM channel), "\ Request a shell.\n\ Return value is undefined.\ ") #define FUNC_NAME s_guile_ssh_channel_request_shell { gssh_channel_t *data = gssh_channel_from_scm (channel); int res; GSSH_VALIDATE_OPEN_CHANNEL (channel, SCM_ARG1, FUNC_NAME); if (! _gssh_channel_parent_session_connected_p (data)) guile_ssh_error1 (FUNC_NAME, "Parent session is not connected", channel); res = ssh_channel_request_shell (data->ssh_channel); _gssh_log_debug_format(FUNC_NAME, channel, "result: %d", res); if (res != SSH_OK) { ssh_session session = ssh_channel_get_session (data->ssh_channel); guile_ssh_session_error1 (FUNC_NAME, session, channel); } return SCM_UNDEFINED; } #undef FUNC_NAME /* Set an environment variable NAME to value VALUE Return value is undefined. */ SCM_DEFINE_N (guile_ssh_channel_request_env, "channel-request-env", 3, (SCM channel, SCM name, SCM value), "\ Set an environment variable NAME to value VALUE.\n\ Return value is undefined.\ ") #define FUNC_NAME s_guile_ssh_channel_request_env { gssh_channel_t *data = gssh_channel_from_scm (channel); char *c_name; char *c_value; int res; GSSH_VALIDATE_OPEN_CHANNEL (channel, SCM_ARG1, FUNC_NAME); SCM_ASSERT (scm_is_string (name), name, SCM_ARG2, FUNC_NAME); SCM_ASSERT (scm_is_string (value), value, SCM_ARG3, FUNC_NAME); if (! _gssh_channel_parent_session_connected_p (data)) guile_ssh_error1 (FUNC_NAME, "Parent session is not connected", channel); c_name = scm_to_locale_string (name); c_value = scm_to_locale_string (value); res = ssh_channel_request_env (data->ssh_channel, c_name, c_value); _gssh_log_debug_format(FUNC_NAME, scm_list_3 (channel, name, value), "result: %d", res); if (res != SSH_OK) { ssh_session session = ssh_channel_get_session (data->ssh_channel); guile_ssh_session_error1 (FUNC_NAME, session, channel); } return SCM_UNDEFINED; } #undef FUNC_NAME /* Asserts: - RES is one of the valid contants described in 'libssh.h'. */ SCM _ssh_result_to_symbol (int res) #define FUNC_NAME "_ssh_result_to_symbol" { switch (res) { case SSH_OK: return scm_from_locale_symbol ("ok"); case SSH_AGAIN: return scm_from_locale_symbol ("again"); case SSH_ERROR: return scm_from_locale_symbol ("error"); case SSH_EOF: return scm_from_locale_symbol ("eof"); default: /* Must not happen. */ _gssh_log_error_format(FUNC_NAME, SCM_BOOL_F, "Unknown SSH result: %d", res); assert (0); return SCM_BOOL_F; } } #undef FUNC_NAME SCM_DEFINE_N (guile_ssh_channel_open_forward, "%channel-open-forward", 5, (SCM channel, SCM remote_host, SCM remote_port, SCM source_host, SCM local_port), "") #define FUNC_NAME s_guile_ssh_channel_open_forward { gssh_channel_t *cd = gssh_channel_from_scm (channel); char *c_remote_host = NULL; char *c_source_host = NULL; gssh_session_t *sd = NULL; int res; SCM_ASSERT (scm_is_string (remote_host), remote_host, SCM_ARG2, FUNC_NAME); SCM_ASSERT (scm_is_number (remote_port), remote_port, SCM_ARG3, FUNC_NAME); SCM_ASSERT (scm_is_string (source_host), source_host, SCM_ARG4, FUNC_NAME); SCM_ASSERT (scm_is_number (local_port), local_port, SCM_ARG5, FUNC_NAME); if (! cd) guile_ssh_error1 (FUNC_NAME, "Channel is freed: ", channel); if (! _gssh_channel_parent_session_connected_p (cd)) guile_ssh_error1 (FUNC_NAME, "Parent session is not connected", channel); sd = gssh_session_from_scm (cd->session); if (! sd) guile_ssh_error1 (FUNC_NAME, "Session is freed: ", cd->session); if (! ssh_is_connected (sd->ssh_session)) guile_ssh_error1 (FUNC_NAME, "Session is disconnected: ", channel); scm_dynwind_begin (0); c_remote_host = scm_to_locale_string (remote_host); scm_dynwind_free (c_remote_host); c_source_host = scm_to_locale_string (source_host); scm_dynwind_free (c_source_host); res = ssh_channel_open_forward (cd->ssh_channel, c_remote_host, scm_to_int32 (remote_port), c_source_host, scm_to_int32 (local_port)); _gssh_log_debug_format(FUNC_NAME, scm_list_5 (channel, remote_host, remote_port, source_host, local_port), "result: %d", res); if (res == SSH_OK) { SCM_SET_CELL_TYPE (channel, SCM_CELL_TYPE (channel) | SCM_OPN); } else { _gssh_log_warning (FUNC_NAME, "Could not open forwarding channel", scm_list_n (channel, remote_host, remote_port, source_host, local_port, SCM_UNDEFINED)); } scm_dynwind_end (); scm_remember_upto_here_1 (channel); scm_remember_upto_here_1 (cd->session); return _ssh_result_to_symbol (res); } #undef FUNC_NAME SCM_DEFINE_N (guile_ssh_channel_listen_forward, "%channel-listen-forward", 3, (SCM session, SCM address, SCM port), "") #define FUNC_NAME s_guile_ssh_channel_listen_forward { gssh_session_t *sd = gssh_session_from_scm (session); char *c_address = NULL; int bound_port; int res; SCM_ASSERT (scm_is_string (address) || scm_is_bool (address), address, SCM_ARG2, FUNC_NAME); SCM_ASSERT (scm_is_number (port), port, SCM_ARG3, FUNC_NAME); scm_dynwind_begin (0); if (scm_is_string (address)) { c_address = scm_to_locale_string (address); scm_dynwind_free (c_address); } res = ssh_forward_listen (sd->ssh_session, c_address, scm_to_int (port), &bound_port); _gssh_log_debug_format(FUNC_NAME, scm_list_3 (session, address, port), "result: %d", res); if (res != SSH_OK) bound_port = -1; else if (scm_zero_p (port)) bound_port = scm_to_int (port); scm_dynwind_end (); return scm_values (scm_list_2 (_ssh_result_to_symbol (res), scm_from_int (bound_port))); } #undef FUNC_NAME SCM_DEFINE_N (guile_ssh_channel_accept_forward, "%channel-accept-forward", 2, (SCM session, SCM timeout), "") #define FUNC_NAME s_guile_ssh_channel_accept_forward { gssh_session_t *sd = gssh_session_from_scm (session); ssh_channel c_channel = NULL; SCM channel = SCM_BOOL_F; int port; SCM_ASSERT (scm_is_number (timeout), timeout, SCM_ARG2, FUNC_NAME); c_channel = ssh_channel_accept_forward (sd->ssh_session, scm_to_int (timeout), &port); if (c_channel) { channel = ssh_channel_to_scm (c_channel, session, SCM_RDNG | SCM_WRTNG); SCM_SET_CELL_TYPE (channel, SCM_CELL_TYPE (channel) | SCM_OPN); } return scm_values (scm_list_2 (channel, scm_from_int (port))); } #undef FUNC_NAME /* FIXME: Should it be defined in some other module? */ SCM_DEFINE_N (guile_ssh_channel_cancel_forward, "channel-cancel-forward", 3, (SCM session, SCM address, SCM port), "") #define FUNC_NAME s_guile_ssh_channel_cancel_forward { gssh_session_t *sd = gssh_session_from_scm (session); char *c_address = NULL; int res; SCM_ASSERT (scm_is_string (address), address, SCM_ARG2, FUNC_NAME); SCM_ASSERT (scm_is_number (port), port, SCM_ARG3, FUNC_NAME); scm_dynwind_begin (0); c_address = scm_to_locale_string (address); scm_dynwind_free (c_address); res = ssh_forward_cancel (sd->ssh_session, c_address, scm_to_int32 (port)); scm_dynwind_end (); return _ssh_result_to_symbol (res); } #undef FUNC_NAME SCM_DEFINE_N (guile_ssh_channel_set_pty_size_x, "channel-set-pty-size!", 3, (SCM channel, SCM col, SCM row), "\ Change size of the PTY to columns COL and rows ROW.\n\ eturn value is undefined.\ ") #define FUNC_NAME s_guile_ssh_channel_set_pty_size_x { gssh_channel_t *data = gssh_channel_from_scm (channel); GSSH_VALIDATE_OPEN_CHANNEL (channel, SCM_ARG1, FUNC_NAME); SCM_ASSERT (scm_is_unsigned_integer (col, 0, UINT32_MAX), col, SCM_ARG2, FUNC_NAME); SCM_ASSERT (scm_is_unsigned_integer (row, 0, UINT32_MAX), row, SCM_ARG2, FUNC_NAME); if (! _gssh_channel_parent_session_connected_p (data)) guile_ssh_error1 (FUNC_NAME, "Parent session is not connected", channel); ssh_channel_change_pty_size (data->ssh_channel, scm_to_uint32 (col), scm_to_uint32 (row)); return SCM_UNDEFINED; } #undef FUNC_NAME SCM_DEFINE_N (guile_ssh_channel_set_stream_x, "channel-set-stream!", 2, (SCM channel, SCM stream_name), "\ Set stream STREAM_NAME for channel CHANNEL. STREAM_NAME must be one of the \n\ following symbols: \"stdout\" (default), \"stderr\".\n\ Return value is undefined.\ ") #define FUNC_NAME s_guile_ssh_channel_set_stream_x { gssh_channel_t *cd = gssh_channel_from_scm (channel); GSSH_VALIDATE_OPEN_CHANNEL (channel, SCM_ARG1, FUNC_NAME); SCM_ASSERT (scm_is_symbol (stream_name), stream_name, SCM_ARG2, FUNC_NAME); if (! _gssh_channel_parent_session_connected_p (cd)) guile_ssh_error1 (FUNC_NAME, "Parent session is not connected", channel); if (scm_is_eq (stream_name, scm_from_locale_symbol ("stdout"))) { cd->is_stderr = 0; } else if (scm_is_eq (stream_name, scm_from_locale_symbol ("stderr"))) { cd->is_stderr = 1; } else { guile_ssh_error1 (FUNC_NAME, "Wrong stream name. Possible names are: " "'stdout, 'stderr", stream_name); } return SCM_UNDEFINED; } #undef FUNC_NAME SCM_DEFINE_1 (guile_ssh_channel_get_stream, "channel-get-stream", (SCM channel), "\ Get current stream name from CHANNEL. Throw `guile-ssh-error' on error.\n\ Return one of the following symbols: \"stdout\", \"stderr\".\ ") #define FUNC_NAME s_guile_ssh_channel_get_stream { gssh_channel_t *cd = gssh_channel_from_scm (channel); SCM result = SCM_UNDEFINED; GSSH_VALIDATE_OPEN_CHANNEL (channel, SCM_ARG1, FUNC_NAME); if (! _gssh_channel_parent_session_connected_p (cd)) guile_ssh_error1 (FUNC_NAME, "Parent session is not connected", channel); if (cd->is_stderr == 0) { result = scm_from_locale_symbol ("stdout"); } if (cd->is_stderr == 1) { result = scm_from_locale_symbol ("stderr"); } else { guile_ssh_error1 (FUNC_NAME, "Wrong stream.", scm_from_int (cd->is_stderr)); } return result; } #undef FUNC_NAME SCM_DEFINE_1 (guile_ssh_channel_get_session, "channel-get-session", (SCM channel), "\ Get the session to which belongs the CHANNEL. Throw `guile-ssh-error' on an \n\ error. Return the session.\ ") #define FUNC_NAME s_guile_ssh_channel_get_session { gssh_channel_t *cd = gssh_channel_from_scm (channel); GSSH_VALIDATE_CHANNEL_DATA (cd, channel, FUNC_NAME); return cd->session; } #undef FUNC_NAME /* Predicates */ SCM_DEFINE_1 (guile_ssh_channel_is_open_p, "channel-open?", (SCM channel), "Return #t if channel CHANNEL is open, #f otherwise.") { gssh_channel_t *data = gssh_channel_from_scm (channel); if (data == NULL) return SCM_BOOL_F; if (data->is_remote_closed) return SCM_BOOL_F; if (ssh_channel_is_open (data->ssh_channel)) return SCM_BOOL_T; return SCM_BOOL_F; } SCM_DEFINE_1 (gssh_channel_send_eof, "%channel-send-eof", (SCM channel), "") #define FUNC_NAME s_gssh_channel_send_eof { gssh_channel_t *cd = gssh_channel_from_scm (channel); scm_t_bits pt_bits; int rc; GSSH_VALIDATE_CHANNEL_DATA (cd, channel, FUNC_NAME); if (! _gssh_channel_parent_session_connected_p (cd)) guile_ssh_error1 (FUNC_NAME, "Parent session is not connected", channel); pt_bits = SCM_CELL_TYPE (channel); if ((pt_bits & SCM_WRTNG) == 0) { guile_ssh_error1 (FUNC_NAME, "Could not send EOF on an input channel", channel); } rc = ssh_channel_send_eof (cd->ssh_channel); if (rc == SSH_ERROR) guile_ssh_error1 (FUNC_NAME, "Could not send EOF on a channel", channel); SCM_SET_CELL_TYPE (channel, pt_bits & ~SCM_WRTNG); return SCM_UNDEFINED; } #undef FUNC_NAME SCM_DEFINE_1 (guile_ssh_channel_is_eof_p, "channel-eof?", (SCM channel), "\ Return #t if remote has set EOF, #f otherwise.\n\ Throw `guile-ssh-error' if the channel has been closed and freed.\ ") #define FUNC_NAME s_guile_ssh_channel_is_eof_p { gssh_channel_t *data = gssh_channel_from_scm (channel); GSSH_VALIDATE_CHANNEL_DATA (data, channel, FUNC_NAME); return scm_from_bool (ssh_channel_is_eof (data->ssh_channel)); } #undef FUNC_NAME /* Initialize channel related functions. */ void init_channel_func (void) { #include "channel-func.x" } /* channel-func.c ends here */ guile-ssh-0.18.0/libguile-ssh/channel-func.h000066400000000000000000000024571471416131000206070ustar00rootroot00000000000000/* Copyright (C) 2013, 2014, 2015 Artyom V. Poptsov * * This file is part of Guile-SSH * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #ifndef __CHANNEL_FUNC_H__ #define __CHANNEL_FUNC_H__ extern SCM guile_ssh_channel_open_session (SCM arg1); extern SCM guile_ssh_channel_request_exec (SCM arg1, SCM arg2); extern SCM guile_ssh_channel_request_send_exit_status (SCM arg1, SCM arg2); extern SCM guile_ssh_channel_is_open_p (SCM arg1); extern SCM guile_ssh_channel_is_eof_p (SCM arg1); extern SCM guile_ssh_channel_set_pty_size_x (SCM arg1, SCM arg2, SCM arg3); extern SCM guile_ssh_channel_get_exit_status (SCM arg1); extern void init_channel_func (void); #endif /* ifndef __CHANNEL_FUNC_H__ */ guile-ssh-0.18.0/libguile-ssh/channel-main.c000066400000000000000000000016611471416131000205670ustar00rootroot00000000000000/* * Copyright (C) 2013 Artyom V. Poptsov * * This file is part of Guile-SSH. * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #include #include "channel-type.h" #include "channel-func.h" #include "threads.h" void init_channel (void) { init_channel_type (); init_channel_func (); init_pthreads (); } guile-ssh-0.18.0/libguile-ssh/channel-type.c000066400000000000000000000353241471416131000206270ustar00rootroot00000000000000/* channel-type.c -- SSH channel smob. * * Copyright (C) 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Artyom V. Poptsov * Copyright (C) 2017 Ludovic Courtès * * This file is part of Guile-SSH. * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #include #include #include #include #include #include "session-type.h" #include "channel-type.h" #include "error.h" #include "common.h" #include "log.h" static const char* GSSH_CHANNEL_TYPE_NAME = "channel"; gssh_port_t channel_tag; enum { DEFAULT_PORT_R_BUFSZ = 256, /* Default read buffer size */ DEFAULT_PORT_W_BUFSZ = 1 /* Default write buffer size */ }; /* Ptob specific procedures */ #if USING_GUILE_BEFORE_2_2 /* Read data from the channel. Return EOF if no data is available or throw `guile-ssh-error' if an error occurred. */ static int ptob_fill_input (SCM channel) #define FUNC_NAME "ptob_fill_input" { gssh_channel_t *cd = gssh_channel_from_scm (channel); scm_port *pt = SCM_PTAB_ENTRY (channel); int res; if (cd->is_remote_closed || (! _gssh_channel_parent_session_connected_p (cd))) { return EOF; } if (! ssh_channel_is_open (cd->ssh_channel)) return EOF; /* Update state of the underlying channel and check whether we have data to read or not. */ res = ssh_channel_poll_timeout (cd->ssh_channel, cd->timeout, cd->is_stderr); switch (res) { case SSH_ERROR: guile_ssh_error1 (FUNC_NAME, "Error polling channel", channel); case SSH_EOF: return EOF; case 0: log_backtrace (FUNC_NAME); assert (0); return EOF; /* Must not happen. */ } else if (res == SSH_EOF) return EOF; res = ssh_channel_read (cd->ssh_channel, pt->read_buf, pt->read_buf_size, cd->is_stderr); if (res == SSH_ERROR) guile_ssh_error1 (FUNC_NAME, "Error reading from the channel", channel); /* `ssh_channel_read' sometimes returns 0 even if `ssh_channel_poll' returns a positive value. So we must ensure that res != 0 otherwise an assertion in `scm_i_fill_input' won't be meet (see `ports.c' in Guile 2.0.9). */ if ((! res) || (res == SSH_AGAIN)) return EOF; pt->read_pos = pt->read_buf; pt->read_end = pt->read_buf + res; return *pt->read_buf; } #undef FUNC_NAME /* Write data to the channel. Throw `guile-ssh-error' on a libssh error, or signal a system error if amount of data written is smaller than size SZ. */ static void ptob_write (SCM channel, const void *data, size_t sz) #define FUNC_NAME "ptob_write" { gssh_channel_t *channel_data = gssh_channel_from_scm (channel); int res = ssh_channel_write (channel_data->ssh_channel, data, sz); if (res == SSH_ERROR) { ssh_session session = ssh_channel_get_session (channel_data->ssh_channel); guile_ssh_session_error1 (FUNC_NAME, session, channel); } if (res < sz) scm_syserror (FUNC_NAME); } #undef FUNC_NAME /* Complete the processing of buffered output data. Currently this callback makes no effect because the channel CHANNEL uses unbuffered output. */ static void ptob_flush (SCM channel) #define FUNC_NAME "ptob_flush" { scm_port *pt = SCM_PTAB_ENTRY (channel); gssh_channel_t *cd = gssh_channel_from_scm (channel); size_t wrsize = pt->write_pos - pt->write_buf; if (wrsize) { int res = ssh_channel_write (cd->ssh_channel, pt->write_buf, wrsize); if (res == SSH_ERROR) { ssh_session session = ssh_channel_get_session (cd->ssh_channel); guile_ssh_session_error1 (FUNC_NAME, session, channel); } } pt->write_pos = pt->write_buf; } #undef FUNC_NAME #else /* !USING_GUILE_BEFORE_2_2 */ static size_t read_from_channel_port (SCM channel, SCM dst, size_t start, size_t count) #define FUNC_NAME "read_from_channel_port" { char *data = (char *) SCM_BYTEVECTOR_CONTENTS (dst) + start; gssh_channel_t *cd = gssh_channel_from_scm (channel); int res; _gssh_log_debug_format (FUNC_NAME, channel, "Going to read %d bytes (timeout: %d)", count, cd->timeout); if (! ssh_channel_is_open (cd->ssh_channel)) return 0; res = ssh_channel_read_timeout (cd->ssh_channel, data, count, cd->is_stderr, cd->timeout); _gssh_log_debug_format (FUNC_NAME, channel, "read result: %d", res); if (res == SSH_AGAIN) { res = 0; } else if (res == SSH_ERROR) { if (cd->is_remote_closed || (! _gssh_channel_parent_session_connected_p (cd))) { res = (scm_t_wchar) 0; } else { guile_ssh_error1 (FUNC_NAME, "Error reading from the channel", channel); } } return res; } #undef FUNC_NAME static size_t write_to_channel_port (SCM channel, SCM src, size_t start, size_t count) #define FUNC_NAME "write_to_channel_port" { char *data = (char *) SCM_BYTEVECTOR_CONTENTS (src) + start; gssh_channel_t *channel_data = gssh_channel_from_scm (channel); if (channel_data->is_remote_closed) return 0; if (! _gssh_channel_parent_session_connected_p (channel_data)) guile_ssh_error1 (FUNC_NAME, "Parent session is not connected", channel); int res = ssh_channel_write (channel_data->ssh_channel, data, count); if (res == SSH_ERROR) { ssh_session session = ssh_channel_get_session (channel_data->ssh_channel); guile_ssh_session_error1 (FUNC_NAME, session, channel); } return res; } #undef FUNC_NAME #endif /* !USING_GUILE_BEFORE_2_2 */ /* Poll the underlying SSH channel for data, return amount of data available for reading. Throw `guile-ssh-error' on error. */ static int ptob_input_waiting (SCM channel) #define FUNC_NAME "ptob_input_waiting" { gssh_channel_t *cd = gssh_channel_from_scm (channel); int res = ssh_channel_poll (cd->ssh_channel, cd->is_stderr); _gssh_log_debug_format (FUNC_NAME, channel, "poll result: %d%s", res, (res == SSH_ERROR) ? " (SSH_ERROR)" : (res == SSH_EOF) ? " (SSH_EOF)" : ""); if (res == SSH_ERROR) guile_ssh_error1 (FUNC_NAME, "An error occurred.", channel); return (res != SSH_EOF) ? res : 0; } #undef FUNC_NAME /* Close underlying SSH channel and free all allocated resources. */ #if USING_GUILE_BEFORE_2_2 static int #else static void #endif ptob_close (SCM channel) { gssh_channel_t *ch = gssh_channel_from_scm (channel); #if USING_GUILE_BEFORE_2_2 scm_port *pt = SCM_PTAB_ENTRY (channel); ptob_flush (channel); #endif if (ch) { gssh_session_t *sd = gssh_session_from_scm (ch->session); ssh_remove_channel_callbacks (ch->ssh_channel, ch->callbacks); gssh_session_del_channel_x (sd, channel); if (ch->is_remote_closed == 1) { _gssh_log_debug1 ("ptob_close", "the channel is closed" " by the closing request from the remote side."); _gssh_log_debug1 ("ptob_close", "Freeing the channel...") ssh_channel_free (ch->ssh_channel); _gssh_log_debug1 ("ptob_close", "Freeing the local channel... done"); } else if (sd && ssh_is_connected (sd->ssh_session)) { if (ssh_channel_is_open (ch->ssh_channel)) { _gssh_log_debug ("ptob_close", "closing and freeing the channel...", channel); ssh_channel_free (ch->ssh_channel); _gssh_log_debug1 ("ptob_close", "closing and freeing the channel... done"); } } else { _gssh_log_debug1 ("ptob_close", "the channel is already freed" " along with the parent session."); } _gssh_log_debug1 ("ptob_close", "Freeing the channel callbacks..."); free (ch->callbacks); ch->callbacks = NULL; _gssh_log_debug1 ("ptob_close", "Freeing the channel callbacks... done"); scm_gc_unprotect_object (ch->session); } else { _gssh_log_debug1 ("ptob_close", "the channel is already freed."); } SCM_SETSTREAM (channel, NULL); #if USING_GUILE_BEFORE_2_2 _gssh_log_debug1 ("ptob_close", "Freeing the channel buffers ..."); scm_gc_free (pt->write_buf, pt->write_buf_size, "port write buffer"); scm_gc_free (pt->read_buf, pt->read_buf_size, "port read buffer"); _gssh_log_debug1 ("ptob_close", "Freeing the channel buffers ... done"); return 0; #endif } /* Print the CHANNEL object to port PORT. */ static int print_channel (SCM channel, SCM port, scm_print_state *pstate) { gssh_channel_t *ch = NULL; #if USING_GUILE_BEFORE_2_2 if (SCM_PTAB_ENTRY (channel)) ch = gssh_channel_from_scm (channel); #else ch = gssh_channel_from_scm (channel); #endif scm_puts ("#<", port); if (! ch) { scm_puts ("unknown channel (freed) ", port); } else { if (! _gssh_channel_parent_session_connected_p (ch)) { scm_puts ("unknown channel (freed) ", port); } else { scm_print_port_mode (channel, port); scm_puts ("channel ", port); if (SCM_OPPORTP (channel)) { if (ssh_channel_is_open (ch->ssh_channel)) { scm_puts ("(open) ", port); } else if (ch->is_remote_closed == 1) { scm_puts ("(closed by the remote side) ", port); } else { scm_puts ("(closed) ", port); } } else { scm_puts ("(closed) ", port); } } } scm_display (_scm_object_hex_address (channel), port); scm_puts (">", port); return 1; } static void channel_close_callback (ssh_session session, ssh_channel channel, void *userdata) { gssh_channel_t* cd = (gssh_channel_t*) userdata; if (cd) { cd->is_remote_closed = 1; } } /* Helper procedures */ /* Pack the SSH channel CH to a Scheme port and return newly created port. Asserts: - FLAGS variable has only SCM_RDNG and SCM_WRTNG bits set. */ SCM ssh_channel_to_scm (ssh_channel ch, SCM session, long flags) { SCM ptob; gssh_channel_t *channel_data; assert ((flags & ~(SCM_RDNG | SCM_WRTNG)) == 0); channel_data = scm_gc_malloc (sizeof (gssh_channel_t), GSSH_CHANNEL_TYPE_NAME); channel_data->ssh_channel = ch; channel_data->is_stderr = 0; /* Reading from stderr disabled by default */ channel_data->session = session; channel_data->is_remote_closed = 0; channel_data->timeout = -1; /* Infinite timeout. */ scm_gc_protect_object (channel_data->session); #if USING_GUILE_BEFORE_2_2 { scm_port *pt; ptob = scm_new_port_table_entry (channel_tag); pt = SCM_PTAB_ENTRY (ptob); pt->rw_random = 0; /* Output init */ pt->write_buf_size = DEFAULT_PORT_W_BUFSZ; pt->write_buf = scm_gc_malloc (pt->write_buf_size, "port write buffer"); pt->write_pos = pt->write_buf; pt->write_end = pt->write_buf; /* Input init */ pt->read_buf_size = DEFAULT_PORT_R_BUFSZ; pt->read_buf = scm_gc_malloc (pt->read_buf_size, "port read buffer"); pt->read_pos = pt->read_buf; pt->read_end = pt->read_buf; SCM_SET_CELL_TYPE (ptob, channel_tag | flags); SCM_SETSTREAM (ptob, channel_data); } #else /* As for file ports returned by 'socket', 'accept', & co., make the port unbuffered by default so that writes go straight to the remote host, as people typically expect. */ ptob = scm_c_make_port (channel_tag, flags | SCM_BUF0, (scm_t_bits) channel_data); #endif channel_data->callbacks = calloc (1, sizeof (struct ssh_channel_callbacks_struct)); channel_data->callbacks->channel_close_function = channel_close_callback; channel_data->callbacks->userdata = (void *) channel_data; ssh_callbacks_init (channel_data->callbacks); if (ssh_set_channel_callbacks (ch, channel_data->callbacks) != SSH_OK) { guile_ssh_error1(__func__, "Could not set channel callbacks", ptob); } return ptob; } /* Convert X to a SSH channel. Return the channel data or NULL if the channel has been freed. */ gssh_channel_t * gssh_channel_from_scm (SCM x) { /* In Guile 2.0 ports and SMOBs were all alike; that is no longer the case in 2.2. */ #if USING_GUILE_BEFORE_2_2 scm_assert_smob_type (channel_tag, x); #else SCM_ASSERT_TYPE (SCM_PORTP (x) && SCM_PORT_TYPE (x) == channel_tag, x, 1, __func__, "channel-port"); #endif return (gssh_channel_t *) SCM_STREAM (x); } /** * Predicate. Return 1 if the parent session is connected, 0 otherwise. */ int _gssh_channel_parent_session_connected_p (gssh_channel_t* cd) { gssh_session_t *sd = gssh_session_from_scm (cd->session); return (sd && ssh_is_connected (sd->ssh_session)); } /* channel smob initialization. */ void init_channel_type (void) { channel_tag = scm_make_port_type ((char*) GSSH_CHANNEL_TYPE_NAME, #if USING_GUILE_BEFORE_2_2 &ptob_fill_input, &ptob_write #else read_from_channel_port, write_to_channel_port #endif ); scm_set_port_close (channel_tag, ptob_close); scm_set_port_needs_close_on_gc (channel_tag, 1); #if USING_GUILE_BEFORE_2_2 scm_set_port_flush (channel_tag, ptob_flush); /* The 'equalp' function has no equivalent with Guile 2.2 but 'eq?' should be equivalent in practice. */ scm_set_port_equalp (channel_tag, equalp_channel); #endif scm_set_port_input_waiting (channel_tag, ptob_input_waiting); scm_set_port_print (channel_tag, print_channel); scm_c_define ("RDNG", scm_from_long (SCM_RDNG)); scm_c_define ("WRTNG", scm_from_long (SCM_WRTNG)); #include "channel-type.x" } /* channel-type.c ends here */ guile-ssh-0.18.0/libguile-ssh/channel-type.h000066400000000000000000000061421471416131000206300ustar00rootroot00000000000000/* Copyright (C) 2013-2020 Artyom V. Poptsov * * This file is part of Guile-SSH * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #ifndef __CHANNEL_TYPE_H__ #define __CHANNEL_TYPE_H__ #include #include #include #include "common.h" extern gssh_port_t channel_tag; /* Smob data. */ struct gssh_channel { /* Reference to the parent session. We need to keep the reference to prevent the session from premature freeing by the GC. */ SCM session; ssh_channel ssh_channel; uint8_t is_stderr; /* When a remote side is closed a channel this flag is set to 1. */ uint8_t is_remote_closed; /* libssh channel callbacks. */ struct ssh_channel_callbacks_struct* callbacks; /* libssh channel poll timeout. This timeout passed to the poll(2) procedure. */ int32_t timeout; }; typedef struct gssh_channel gssh_channel_t; /* Make sure that the channel data is valid. Throw `guile-ssh-error' if the channel SCM has been closed and freed. */ #define GSSH_VALIDATE_CHANNEL_DATA(cd, scm, fn) \ do { \ if (! cd) \ guile_ssh_error1 (fn, "Channel has been closed and freed.", scm); \ } while (0) /* Make sure that the channel SCM is open. */ #if USING_GUILE_BEFORE_2_2 #define GSSH_VALIDATE_OPEN_CHANNEL(scm, pos, fn) \ do { \ if (! SCM_PTAB_ENTRY (channel)) \ scm_wrong_type_arg_msg (fn, pos, scm, "open channel"); \ SCM_ASSERT_TYPE (SCM_OPPORTP (scm), scm, pos, fn, "open channel"); \ } while (0) #else #define GSSH_VALIDATE_OPEN_CHANNEL(scm, pos, fn) \ do { \ SCM_ASSERT_TYPE (SCM_OPPORTP (scm), scm, pos, fn, "open channel"); \ } while (0) #endif /* USING_GUILE_BEFORE_2_2 */ /* API */ extern SCM guile_ssh_make_channel (SCM arg1, SCM flags); extern SCM guile_ssh_is_channel_p (SCM arg1); extern SCM guile_ssh_channel_get_session (SCM arg1); extern void init_channel_type (void); /* Helper procedures */ extern gssh_channel_t *gssh_channel_from_scm (SCM x); extern SCM ssh_channel_to_scm (ssh_channel ch, SCM session, long flags); int _gssh_channel_parent_session_connected_p (gssh_channel_t* cd); #endif /* ifndef __CHANNEL_TYPE_H__ */ guile-ssh-0.18.0/libguile-ssh/common.c000066400000000000000000000051171471416131000175250ustar00rootroot00000000000000/* common.c -- Common functions. * * Copyright (C) 2013-2021 Artyom V. Poptsov * * This file is part of Guile-SSH. * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #include #include #include #include #include "common.h" /* Convert the SSH constant VALUE to a Scheme symbol */ SCM gssh_symbol_to_scm (const gssh_symbol_t *types, int value) { const gssh_symbol_t *t; for (t = types; t->symbol; ++t) { if (t->value == value) return scm_from_locale_symbol (t->symbol); } return SCM_BOOL_F; } /* Convert the Scheme symbol VALUE to a SSH constant. Return the apropriate structure that contains the needed constant. */ const gssh_symbol_t * gssh_symbol_from_scm (const gssh_symbol_t *types, SCM value) { const gssh_symbol_t *t; char *sym = scm_to_locale_string (scm_symbol_to_string (value)); for (t = types; t->symbol; ++t) { if (! strcmp (t->symbol, sym)) return t; } return NULL; } /* Return an address of the object OBJ as an hexadecimal number represented as a string. */ SCM _scm_object_hex_address (SCM obj) { return scm_number_to_string (scm_object_address (obj), scm_from_uint (16U)); } void set_smob_callbacks(scm_t_bits tag, gc_mark_callback_t mark_cb, gc_free_callback_t free_cb, gc_equalp_callback_t equalp_cb, gc_print_callback_t print_cb) { scm_set_smob_mark(tag, mark_cb); scm_set_smob_free(tag, free_cb); scm_set_smob_print(tag, print_cb); scm_set_smob_equalp(tag, equalp_cb); } /** Procedure that converts an SCM object to an Guile-UDev structure * pointer. */ SCM compare_objects(SCM x1, SCM x2, converter_t converter) { void* d1 = converter(x1); void* d2 = converter(x2); if ((! d1) || (! d2)) { return SCM_BOOL_F; } else if (d1 != d2) { return SCM_BOOL_F; } else { return SCM_BOOL_T; } } /* common.c ends here. */ guile-ssh-0.18.0/libguile-ssh/common.h000066400000000000000000000061631471416131000175340ustar00rootroot00000000000000/* Copyright (C) 2013-2021 Artyom V. Poptsov * * This file is part of Guile-SSH * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #ifndef __COMMON_H__ #define __COMMON_H__ #include /* Whether we're using Guile < 2.2. */ #define USING_GUILE_BEFORE_2_2 \ (SCM_MAJOR_VERSION < 2 \ || (SCM_MAJOR_VERSION == 2 && SCM_MINOR_VERSION == 0)) /* Simplified version of 'SCM_DEFINE' macro that defines a procedure with empty docstring and without optional and "rest" arguments. */ #define SCM_GSSH_DEFINE(c_name, scheme_name, req, arglist) \ SCM_DEFINE (c_name, scheme_name, req, 0, 0, arglist, "") /** * This macro is a little bit shorter than the original SCM_DEFINE macro, it * allows to define a Scheme procedure with N required parameters. */ #define SCM_DEFINE_N(c_name, scheme_name, req, arglist, docstring) \ SCM_DEFINE(c_name, scheme_name, req, 0, 0, arglist, docstring) /** * Define a Scheme procedure with zero parameters. */ #define SCM_DEFINE_0(c_name, scheme_name, docstring) \ SCM_DEFINE(c_name, scheme_name, 0, 0, 0, (), docstring) /** * Define a Scheme procedure with only one required parameter. */ #define SCM_DEFINE_1(c_name, scheme_name, arglist, docstring) \ SCM_DEFINE(c_name, scheme_name, 1, 0, 0, arglist, docstring) /* The Guile-SSH port type. Guile 2.2 introduced a new port API, so we have a separate implementation for these newer versions. */ #if USING_GUILE_BEFORE_2_2 typedef scm_t_bits gssh_port_t; #else typedef scm_t_port_type* gssh_port_t; #endif struct gssh_symbol { char* symbol; int value; }; typedef struct gssh_symbol gssh_symbol_t; extern SCM gssh_symbol_to_scm (const gssh_symbol_t *types, int value); extern const gssh_symbol_t * gssh_symbol_from_scm (const gssh_symbol_t *types, SCM value); extern SCM _scm_object_hex_address (SCM obj); /* GC callbacks. */ typedef SCM (*gc_mark_callback_t )(SCM obj); typedef size_t (*gc_free_callback_t )(SCM obj); typedef SCM (*gc_equalp_callback_t)(SCM x1, SCM x2); typedef int (*gc_print_callback_t )(SCM obj, SCM port, scm_print_state* ps); void set_smob_callbacks(scm_t_bits tag, gc_mark_callback_t mark_cb, gc_free_callback_t free_cb, gc_equalp_callback_t equalp_cb, gc_print_callback_t print_cb); typedef void* (*converter_t)(SCM x); SCM compare_objects(SCM x1, SCM x2, converter_t converter); #endif /* ifndef __COMMON_H__ */ /* common.h ends here. */ guile-ssh-0.18.0/libguile-ssh/error.c000066400000000000000000000030331471416131000173610ustar00rootroot00000000000000/* ssh-error.c -- Error reporting to Guile. * * Copyright (C) 2013, 2014, 2015, 2016, 2017 Artyom V. Poptsov * * This file is part of Guile-SSH. * * Guile-SSH 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 3 of the License, or * (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #include #include #include #include "error.h" #include "log.h" /* Report an error */ void guile_ssh_error (const char *proc, const char *msg, SCM args, SCM rest) { scm_error (scm_from_locale_symbol (GUILE_SSH_ERROR), proc, msg, args, rest); } /* Report an error (shorter version). */ void guile_ssh_error1 (const char *proc, const char *msg, SCM args) { _gssh_log_error (proc, msg, args); scm_error (scm_from_locale_symbol (GUILE_SSH_ERROR), proc, msg, args, SCM_BOOL_F); } /* Report a session error. */ void guile_ssh_session_error1 (const char *proc, ssh_session session, SCM args) { guile_ssh_error1 (proc, ssh_get_error (session), args); } /* ssh-error.c ends here */ guile-ssh-0.18.0/libguile-ssh/error.h000066400000000000000000000023371471416131000173740ustar00rootroot00000000000000/* Copyright (C) 2013 Artyom V. Poptsov * * This file is part of Guile-SSH * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #ifndef __GUILE_SSH_ERROR_H__ #define __GUILE_SSH_ERROR_H__ #include #define GUILE_SSH_ERROR "guile-ssh-error" extern void guile_ssh_error (const char *proc, const char *msg, SCM args, SCM rest); extern void guile_ssh_error1 (const char *proc, const char *msg, SCM args); extern void guile_ssh_session_error1 (const char *proc, ssh_session session, SCM args); #endif /* ifndef __GUILE_SSH_ERROR_H__ */ guile-ssh-0.18.0/libguile-ssh/key-func.c000066400000000000000000000311231471416131000177520ustar00rootroot00000000000000/* key-func.c -- SSH key manipulation functions. * * Copyright (C) 2013-2023 Artyom V. Poptsov * * This file is part of Guile-SSH. * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #include #include /* strncpy */ #include #include #include "key-type.h" #include "common.h" #include "error.h" /* Get the type of the key KEY_SMOB. Return a key type as a Scheme symbol. The type can be one of the following list: 'dss, 'rsa, 'rsa1, 'unknown */ SCM_DEFINE (guile_ssh_key_get_type, "get-key-type", 1, 0, 0, (SCM key), "\ Get a symbol that represents the type of the SSH key KEY.\n\ Possible types are: 'dss, 'rsa, 'rsa1, 'ecdsa, 'unknown\ ") { gssh_key_t *data = gssh_key_from_scm (key); enum ssh_keytypes_e type = ssh_key_type (data->ssh_key); return _ssh_key_type_to_scm (type); } SCM_DEFINE (guile_ssh_make_keypair, "make-keypair", 2, 0, 0, (SCM type, SCM length), "\ Generate a keypair of specified TYPE and LENGTH. This may take some time.\ Return newly generated private key. Throw `guile-ssh-error' on error.\ ") #define FUNC_NAME s_guile_ssh_make_keypair { ssh_key key = NULL; const gssh_symbol_t *c_type = _scm_to_ssh_key_type (type); int c_length; int res; SCM_ASSERT (scm_is_unsigned_integer (length, 9, UINT32_MAX), length, SCM_ARG2, FUNC_NAME); if (! c_type) guile_ssh_error1 (FUNC_NAME, "Wrong key type", type); c_length = scm_to_int (length); res = ssh_pki_generate (c_type->value, c_length, &key); if (res == SSH_ERROR) { guile_ssh_error1 (FUNC_NAME, "Could not generate key", scm_list_2 (type, length)); } return gssh_key_to_scm (key, SCM_BOOL_F); } #undef FUNC_NAME /* Predicates */ SCM_DEFINE (guile_ssh_is_key_p, "key?", 1, 0, 0, (SCM x), "\ Return #t if X is a SSH key, #f otherwise.\ ") { return scm_from_bool (SCM_SMOB_PREDICATE (key_tag, x)); } SCM_DEFINE (guile_ssh_is_public_key_p, "public-key?", 1, 0, 0, (SCM x), "\ Return #t if X is a SSH key and it contains a public key, #f otherwise.\ ") { return scm_from_bool (SCM_SMOB_PREDICATE (key_tag, x) && _public_key_p (gssh_key_from_scm (x))); } SCM_DEFINE (guile_ssh_is_private_key_p, "private-key?", 1, 0, 0, (SCM x), "\ Return #t if X is a SSH private-key, #f otherwise.\ ") { return scm_from_bool (SCM_SMOB_PREDICATE (key_tag, x) && _private_key_p (gssh_key_from_scm (x))); } /* Convert SSH public key KEY to a scheme string. */ SCM_DEFINE (guile_ssh_public_key_to_string, "public-key->string", 1, 0, 0, (SCM key), "\ Convert SSH public key to a scheme string.\ ") #define FUNC_NAME s_guile_ssh_public_key_to_string { gssh_key_t *key_data = gssh_key_from_scm (key); char *key_str; SCM_ASSERT (_public_key_p (key_data), key, SCM_ARG1, FUNC_NAME); int res = ssh_pki_export_pubkey_base64 (key_data->ssh_key, &key_str); if (res != SSH_OK) guile_ssh_error1 (FUNC_NAME, "Unable to convert the key to a string", key); return scm_take_locale_string (key_str); } #undef FUNC_NAME SCM_DEFINE (guile_ssh_string_to_public_key, "string->public-key", 2, 0, 0, (SCM base64_str, SCM type), "\ Convert Base64 string to a public key. Return new public key.\n\ Throw `guile-ssh-error' on error.\ ") #define FUNC_NAME s_guile_ssh_string_to_public_key { char *c_base64_str = NULL; const gssh_symbol_t *key_type = NULL; ssh_key ssh_public_key = NULL; int res; SCM_ASSERT (scm_is_string (base64_str), base64_str, SCM_ARG1, FUNC_NAME); SCM_ASSERT (scm_is_symbol (type), type, SCM_ARG2, FUNC_NAME); scm_dynwind_begin (0); c_base64_str = scm_to_locale_string (base64_str); scm_dynwind_free (c_base64_str); key_type = _scm_to_ssh_key_type (type); if (! key_type) guile_ssh_error1 (FUNC_NAME, "Wrong key type", type); res = ssh_pki_import_pubkey_base64 (c_base64_str, key_type->value, &ssh_public_key); if (res != SSH_OK) { const char *msg = "Could not convert the given string to a public key"; guile_ssh_error1 (FUNC_NAME, msg, scm_list_2 (base64_str, type)); } scm_dynwind_end (); return gssh_key_to_scm (ssh_public_key, SCM_BOOL_F); } #undef FUNC_NAME /* The callback procedure that meant to be called by libssh. */ static int auth_callback (const char *prompt, char *buf, size_t len, int echo, int verify, void *userdata) { SCM scm_data = (SCM) userdata; SCM scm_callback = scm_assoc_ref (scm_data, scm_from_locale_string ("callback")); SCM scm_userdata = scm_assoc_ref (scm_data, scm_from_locale_string ("user-data")); SCM scm_prompt = scm_from_locale_string (prompt); SCM scm_buf_len = scm_from_int (len); SCM scm_echo_p = scm_from_bool (echo); SCM scm_verify_p = scm_from_bool (verify); SCM result = scm_call_5 (scm_callback, scm_prompt, scm_buf_len, scm_echo_p, scm_verify_p, scm_userdata); if (scm_is_string (result)) { char* pass = scm_to_locale_string (result); strncpy (buf, pass, len); free (pass); return 0; } else if (scm_is_false (result)) { return 0; } else { guile_ssh_error1 ("libssh_auth_callback", "Wrong type of the value returned by a callback", result); return 0; } } SCM_DEFINE (guile_ssh_private_key_from_file, "%private-key-from-file", 3, 0, 0, (SCM filename, SCM callback, SCM user_data), "\ Read private key from a file FILENAME. If the the key isn encrypted the user\n\ will be asked for passphrase to decrypt the key.\n\ \n\ Return a new SSH key of #f on error.\ ") #define FUNC_NAME s_guile_ssh_private_key_from_file { ssh_key ssh_key = NULL; char *c_filename; /* NULL means that either the public key is unecrypted or the user should be asked for the passphrase. */ char *passphrase = NULL; int res; scm_dynwind_begin (0); SCM_ASSERT (scm_is_string (filename), filename, SCM_ARG1, FUNC_NAME); c_filename = scm_to_locale_string (filename); scm_dynwind_free (c_filename); if (scm_is_false (callback)) { res = ssh_pki_import_privkey_file (c_filename, passphrase, NULL, /* auth_fn */ NULL, /* auth_data */ &ssh_key); } else { SCM data = scm_list_2 (scm_cons (scm_from_locale_string ("callback"), callback), scm_cons (scm_from_locale_string ("user-data"), user_data)); res = ssh_pki_import_privkey_file (c_filename, passphrase, auth_callback, /* auth_fn */ data, /* auth_data */ &ssh_key); } if (res == SSH_EOF) { const char *msg = "The file does not exist or permission denied"; guile_ssh_error1 (FUNC_NAME, msg, filename); } else if (res == SSH_ERROR) { const char *msg = "Unable to import a key from the file"; guile_ssh_error1 (FUNC_NAME, msg, filename); } scm_dynwind_end (); return gssh_key_to_scm (ssh_key, SCM_BOOL_F); } #undef FUNC_NAME SCM_DEFINE (guile_ssh_private_key_to_file, "private-key-to-file", 2, 0, 0, (SCM key, SCM file_name), "\ Export a private KEY to file FILE_NAME. Throw `guile-ssh-error' on error. \ Return value is undefined.\ ") #define FUNC_NAME s_guile_ssh_private_key_to_file { gssh_key_t *kd = gssh_key_from_scm (key); char *c_file_name = NULL; int res; scm_dynwind_begin (0); SCM_ASSERT (_private_key_p (kd), key, SCM_ARG1, FUNC_NAME); SCM_ASSERT (scm_is_string (file_name), file_name, SCM_ARG2, FUNC_NAME); c_file_name = scm_to_locale_string (file_name); scm_dynwind_free (c_file_name); res = ssh_pki_export_privkey_file (kd->ssh_key, NULL, /* passphrase */ NULL, /* auth_fn */ NULL, /* auth_data */ c_file_name); if (res == SSH_ERROR) { guile_ssh_error1 (FUNC_NAME, "Unable to export a key to a file", scm_list_2 (key, file_name)); } scm_dynwind_end (); return SCM_UNDEFINED; } #undef FUNC_NAME SCM_DEFINE (guile_ssh_public_key_from_private_key, "private-key->public-key", 1, 0, 0, (SCM key), "\ Get public key from a private key KEY.\ ") #define FUNC_NAME s_guile_ssh_public_key_from_private_key { gssh_key_t *private_key_data = gssh_key_from_scm (key); ssh_key ssh_public_key = NULL; int res; SCM_ASSERT (_private_key_p (private_key_data), key, SCM_ARG1, FUNC_NAME); res = ssh_pki_export_privkey_to_pubkey (private_key_data->ssh_key, &ssh_public_key); if (res != SSH_OK) return SCM_BOOL_F; return gssh_key_to_scm (ssh_public_key, SCM_BOOL_F); } #undef FUNC_NAME /* Read public key from a file FILENAME. * * Return a SSH key smob. */ SCM_DEFINE (guile_ssh_public_key_from_file, "public-key-from-file", 1, 0, 0, (SCM filename), "\ Read public key from a file FILENAME. Return a SSH key.\ ") #define FUNC_NAME s_guile_ssh_public_key_from_file { ssh_key ssh_public_key = NULL; char *c_filename; int res; scm_dynwind_begin (0); SCM_ASSERT (scm_is_string (filename), filename, SCM_ARG1, FUNC_NAME); c_filename = scm_to_locale_string (filename); scm_dynwind_free (c_filename); res = ssh_pki_import_pubkey_file (c_filename, &ssh_public_key); if (res == SSH_EOF) { const char *msg = "The file does not exist or permission denied"; guile_ssh_error1 (FUNC_NAME, msg, filename); } else if (res == SSH_ERROR) { const char *msg = "Unable to import a key from the file"; guile_ssh_error1 (FUNC_NAME, msg, filename); } scm_dynwind_end (); return gssh_key_to_scm (ssh_public_key, SCM_BOOL_F); } #undef FUNC_NAME static gssh_symbol_t hash_types[] = { { "sha1", SSH_PUBLICKEY_HASH_SHA1 }, { "md5", SSH_PUBLICKEY_HASH_MD5 }, { NULL, -1 } }; SCM_DEFINE (guile_ssh_get_public_key_hash, "get-public-key-hash", 2, 0, 0, (SCM key, SCM type), "\ Get hash of the public KEY as a bytevector.\n\ Possible types are: 'sha1, 'md5\n\ Return a bytevector on success, #f on error.\ ") #define FUNC_NAME s_guile_ssh_get_public_key_hash { gssh_key_t *kd = gssh_key_from_scm (key); unsigned char *hash = NULL; size_t hash_len; int res; SCM ret; const gssh_symbol_t *hash_type = NULL; SCM_ASSERT (scm_is_symbol (type), type, SCM_ARG2, FUNC_NAME); scm_dynwind_begin (0); hash_type = gssh_symbol_from_scm (hash_types, type); if (! hash_type) guile_ssh_error1 (FUNC_NAME, "Wrong type", type); res = ssh_get_publickey_hash (kd->ssh_key, hash_type->value, &hash, &hash_len); scm_dynwind_free (hash); if (res == SSH_OK) { size_t idx; ret = scm_c_make_bytevector (hash_len); for (idx = 0; idx < hash_len; ++idx) scm_c_bytevector_set_x (ret, idx, hash[idx]); } else { ret = SCM_BOOL_F; } scm_dynwind_end (); return ret; } #undef FUNC_NAME /* Initialize Scheme procedures. */ void init_key_func (void) { #include "key-func.x" } /* key-func.c ends here */ guile-ssh-0.18.0/libguile-ssh/key-func.h000066400000000000000000000021611471416131000177570ustar00rootroot00000000000000/* Copyright (C) 2013 Artyom V. Poptsov * * This file is part of Guile-SSH * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #ifndef __KEY_FUNC_H__ #define __KEY_FUNC_H__ /* Guile SSH API */ extern SCM guile_ssh_string_to_public_key (SCM arg1, SCM arg2); extern SCM guile_ssh_public_key_to_string (SCM arg1); extern SCM guile_ssh_private_key_from_file (SCM arg1, SCM arg2); extern SCM guile_ssh_public_key_from_file (SCM arg1, SCM arg2); extern void init_key_func (void); #endif /* ifndef __KEY_FUNC_H__ */ guile-ssh-0.18.0/libguile-ssh/key-main.c000066400000000000000000000017231471416131000177460ustar00rootroot00000000000000/* key-main.c -- SSH keys. * * Copyright (C) 2013 Artyom V. Poptsov * * This file is part of Guile-SSH * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #include #include "key-type.h" #include "key-func.h" #include "threads.h" void init_key (void) { init_key_type (); init_key_func (); init_pthreads (); } /* key-main.c ends here */ guile-ssh-0.18.0/libguile-ssh/key-type.c000066400000000000000000000104561471416131000200060ustar00rootroot00000000000000/* key-type.c -- SSH key smobs. * * Copyright (C) 2013-2023 Artyom V. Poptsov * * This file is part of Guile-SSH * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #include #include #include #include "key-type.h" #include "common.h" #include "error.h" scm_t_bits key_tag; /* Smob tag. */ static const char* GSSH_KEY_TYPE_NAME = "key"; static const gssh_symbol_t key_types[] = { { "dss", SSH_KEYTYPE_DSS }, { "rsa", SSH_KEYTYPE_RSA }, { "rsa1", SSH_KEYTYPE_RSA1 }, { "ecdsa", SSH_KEYTYPE_ECDSA }, /* Deprecated in libssh 0.9 */ #if HAVE_LIBSSH_0_9 { "ecdsa-p256", SSH_KEYTYPE_ECDSA_P256 }, { "ecdsa-p384", SSH_KEYTYPE_ECDSA_P384 }, { "ecdsa-p521", SSH_KEYTYPE_ECDSA_P521 }, { "ecdsa-p256-cert01", SSH_KEYTYPE_ECDSA_P256_CERT01 }, { "ecdsa-p384-cert01", SSH_KEYTYPE_ECDSA_P384_CERT01 }, { "ecdsa-p521-cert01", SSH_KEYTYPE_ECDSA_P521_CERT01 }, #endif { "ed25519", SSH_KEYTYPE_ED25519 }, { "unknown", SSH_KEYTYPE_UNKNOWN }, { NULL, -1 } }; /* Smob marking */ static SCM _mark (SCM key_smob) { gssh_key_t *kd = gssh_key_from_scm (key_smob); return kd->parent; } /* Free the smob. */ static size_t _free (SCM arg1) { gssh_key_t *data = (gssh_key_t *) SCM_SMOB_DATA (arg1); if (scm_is_false (data->parent)) { /* It's safe to free the key only if it was not derived from some other object and thereby does not share any resources with it. If the key does have a parent then all the resources will be freed along with it. */ ssh_key_free (data->ssh_key); } return 0; } static SCM _equalp (SCM x1, SCM x2) { return compare_objects(x1, x2, (converter_t) gssh_key_from_scm); } static int _print (SCM smob, SCM port, scm_print_state *pstate) { gssh_key_t *key_data = gssh_key_from_scm (smob); SCM type = guile_ssh_key_get_type (smob); scm_puts ("#", port); return 1; } /* Convert SSH key type to/from a Scheme symbol. Possible symbols are: 'dss, 'rsa, 'rsa1, 'ecdsa, 'unknown */ SCM _ssh_key_type_to_scm (int type) { return gssh_symbol_to_scm (key_types, type); } const gssh_symbol_t * _scm_to_ssh_key_type (SCM type) { return gssh_symbol_from_scm (key_types, type); } /* Helper procedures */ gssh_key_t* make_gssh_key () { return (gssh_key_t *) scm_gc_malloc (sizeof (gssh_key_t), GSSH_KEY_TYPE_NAME); } /* Create a new key object from an libssh KEY, use PARENT as the key object parent. Return the new key object. */ SCM gssh_key_to_scm (ssh_key key, SCM parent) { gssh_key_t *key_data; SCM key_smob; key_data = make_gssh_key (); key_data->ssh_key = key; key_data->parent = parent; SCM_NEWSMOB (key_smob, key_tag, key_data); return key_smob; } /* Convert X to a SSH key. Return a pointer to an gssh_key_t instance. */ gssh_key_t * gssh_key_from_scm (SCM x) { scm_assert_smob_type (key_tag, x); return (gssh_key_t *) SCM_SMOB_DATA (x); } /* Check that KEY is a SSH private key. */ int _private_key_p (gssh_key_t *key) { return ssh_key_is_private (key->ssh_key); } /* Check that KEY is a SSH public key */ int _public_key_p (gssh_key_t *key) { return ssh_key_is_public (key->ssh_key); } /* Key smob initialization. */ void init_key_type (void) { key_tag = scm_make_smob_type (GSSH_KEY_TYPE_NAME, sizeof (gssh_key_t)); set_smob_callbacks (key_tag, _mark, _free, _equalp, _print); #include "key-type.x" } /* private-key.c ends here */ guile-ssh-0.18.0/libguile-ssh/key-type.h000066400000000000000000000033551471416131000200130ustar00rootroot00000000000000/* Copyright (C) 2013-2020 Artyom V. Poptsov * * This file is part of Guile-SSH * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #ifndef __KEY_TYPE_H__ #define __KEY_TYPE_H__ #include #include #include "common.h" extern scm_t_bits key_tag; /* Smob data. */ struct gssh_key { /* Store the parent object to prevent it from premature GC'ing. */ SCM parent; ssh_key ssh_key; }; typedef struct gssh_key gssh_key_t; /* Procedures */ extern SCM guile_ssh_make_keypair (SCM arg1, SCM arg2); extern SCM guile_ssh_is_key_p (SCM arg1); extern SCM guile_ssh_is_public_key_p (SCM arg1); extern SCM guile_ssh_is_private_key_p (SCM arg1); extern SCM guile_ssh_key_get_type (SCM arg1); extern void init_key_type (void); /* Helper procedures */ extern gssh_key_t* make_gssh_key (); extern SCM gssh_key_to_scm (ssh_key key, SCM parent); extern gssh_key_t* gssh_key_from_scm (SCM x); extern int _private_key_p (gssh_key_t *key); extern int _public_key_p (gssh_key_t *key); extern SCM _ssh_key_type_to_scm (int arg1); extern const gssh_symbol_t *_scm_to_ssh_key_type (SCM arg1); #endif /* ifndef __KEY_TYPE_H__ */ guile-ssh-0.18.0/libguile-ssh/log.c000066400000000000000000000266151471416131000170240ustar00rootroot00000000000000/* log.c -- Guile-SSH logging procedures * * Copyright (C) 2014, 2015, 2016, 2017 Artyom V. Poptsov * * This file is part of Guile-SSH * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #include #include #include #include #include #include #include #include /* DEBUG */ #include /* DEBUG */ #include #include #include #include "log.h" #include "error.h" #include "common.h" /* Log verbosity levels used by libssh sessions and servers. */ gssh_symbol_t log_verbosity[] = { /* 0, No logging at all */ { "nolog", SSH_LOG_NOLOG }, /* 1, Only rare and noteworthy events */ { "rare", SSH_LOG_RARE }, /* 2, High level protocol information */ { "protocol", SSH_LOG_PROTOCOL }, /* 3, Lower level protocol infomations, packet level */ { "packet", SSH_LOG_PACKET }, /* 4, Every function path */ { "functions", SSH_LOG_FUNCTIONS }, { NULL, -1 } }; /* Whether the default calback was set or not. */ static int is_logging_callback_set = 0; /* A Scheme log printer. */ static SCM logging_callback = SCM_BOOL_F; static SCM userdata = SCM_BOOL_F; /* The libssh logging callback which calls Scheme callback procedure. */ void libssh_logging_callback (int c_priority, const char *c_function_name, const char *c_message, void *c_userdata) { SCM priority = scm_from_int (c_priority); SCM function = scm_from_locale_string (c_function_name); SCM message = scm_from_locale_string (c_message); scm_call_4 (logging_callback, priority, function, message, userdata); scm_remember_upto_here_1 (priority); scm_remember_upto_here_1 (function); scm_remember_upto_here_1 (message); scm_remember_upto_here_1 (userdata); } /** * Log a backtrace, with a FUNCTION_NAME attached. */ void log_backtrace (const char* function_name) { enum { /* Maximum number of stack frames that can be obtained. */ STACK_BUF_SZ = 20, /* Maximum log message length. */ MESSAGE_BUF_SZ = 120 }; void *array[STACK_BUF_SZ]; char message[MESSAGE_BUF_SZ]; char **strings; int32_t size, i; size = backtrace (array, STACK_BUF_SZ); strings = backtrace_symbols (array, size); if (strings != NULL) { snprintf (message, MESSAGE_BUF_SZ, "Obtained %d stack frames:", size); libssh_logging_callback (SSH_LOG_NOLOG, function_name, message, NULL); fflush (stderr); for (i = 0; i < size; i++) { snprintf (message, MESSAGE_BUF_SZ, "#%-2d %s", i, strings[i]); libssh_logging_callback (SSH_LOG_NOLOG, function_name, message, NULL); fflush (stderr); } } free (strings); } #define TBUF_SZ 64 #define DATE_BUF_SZ 128 static int _get_current_timestring (char *buf, size_t len) { char tbuf[TBUF_SZ]; struct timeval tv; struct tm *tm; time_t t; gettimeofday (&tv, NULL); t = (time_t) tv.tv_sec; tm = localtime (&t); if (tm == NULL) return -1; strftime (tbuf, sizeof (tbuf) - 1, "%Y/%m/%d %H:%M:%S", tm); snprintf (buf, len, "%s.%06ld", tbuf, (long) tv.tv_usec); return 0; } SCM_DEFINE (guile_ssh_default_libssh_log_printer, "%default-libssh-log-printer", 4, 0, 0, (SCM priority, SCM function_name, SCM message, SCM user_data), "") { char date[DATE_BUF_SZ] = {0}; int rc = _get_current_timestring (date, sizeof(date)); scm_puts ("[", scm_current_error_port ()); if (rc == 0) { scm_puts (date, scm_current_error_port ()); scm_puts (", ", scm_current_error_port ()); } scm_display (priority, scm_current_error_port ()); scm_puts ("] ", scm_current_error_port ()); scm_display (message, scm_current_error_port ()); scm_newline (scm_current_error_port ()); scm_remember_upto_here_1 (priority); scm_remember_upto_here_1 (function_name); scm_remember_upto_here_1 (message); scm_remember_upto_here_1 (user_data); return SCM_UNDEFINED; } SCM_DEFINE (guile_ssh_set_logging_callback_x, "set-logging-callback!", 1, 0, 0, (SCM procedure), "") #define FUNC_NAME s_guile_ssh_set_logging_callback_x { SCM_ASSERT (scm_procedure_p (procedure), procedure, SCM_ARG1, FUNC_NAME); if (! is_logging_callback_set) { int res = ssh_set_log_userdata (SCM_BOOL_F); if (res != SSH_OK) guile_ssh_error1 (FUNC_NAME, "Could not set userdata", procedure); res = ssh_set_log_callback (&libssh_logging_callback); if (res != SSH_OK) guile_ssh_error1 (FUNC_NAME, "Could not setup logging", procedure); is_logging_callback_set = 1; } logging_callback = procedure; return SCM_UNDEFINED; } #undef FUNC_NAME SCM_DEFINE (guile_ssh_get_logging_callback, "current-logging-callback", 0, 0, 0, (void), "") { return logging_callback; } SCM_DEFINE (guile_ssh_set_log_useradata_x, "set-log-userdata!", 1, 0, 0, (SCM data), "") #define FUNC_NAME s_guile_ssh_set_log_useradata_x { userdata = data; return SCM_UNDEFINED; } #undef FUNC_NAME SCM_DEFINE (guile_ssh_get_log_userdata, "get-log-userdata", 0, 0, 0, (void), "") { return userdata; } SCM_DEFINE (guile_ssh_write_log, "%write-log", 3, 0, 0, (SCM priority, SCM function_name, SCM message), "\ Write a MESSAGE to the libssh log with the given PRIORITY. Return value is \n\ undefined. \ ") #define FUNC_NAME s_guile_ssh_write_log { const gssh_symbol_t *c_priority; SCM_ASSERT (scm_symbol_p (priority), priority, SCM_ARG1, FUNC_NAME); SCM_ASSERT (scm_string_p (function_name), function_name, SCM_ARG2, FUNC_NAME); SCM_ASSERT (scm_string_p (message), message, SCM_ARG3, FUNC_NAME); SCM userdata = guile_ssh_get_log_userdata (); c_priority = gssh_symbol_from_scm (log_verbosity, priority); if (! c_priority) guile_ssh_error1 (FUNC_NAME, "Wrong priority level", priority); if (c_priority->value > ssh_get_log_level ()) return SCM_UNDEFINED; scm_call_4 (logging_callback, scm_from_int (c_priority->value), function_name, message, userdata); scm_remember_upto_here_1 (priority); scm_remember_upto_here_1 (function_name); scm_remember_upto_here_1 (message); scm_remember_upto_here_1 (userdata); return SCM_UNDEFINED; } #undef FUNC_NAME SCM_DEFINE (guile_ssh_set_log_verbosity_x, "set-log-verbosity!", 1, 0, 0, (SCM verbosity), "\ Set the global log verbosity to a VERBOSITY. Throw `guile-ssh-error' on \ error. Return value is undefined.\ ") #define FUNC_NAME s_guile_ssh_set_log_verbosity_x { const gssh_symbol_t *opt = gssh_symbol_from_scm (log_verbosity, verbosity); int res; if (! opt) guile_ssh_error1 (FUNC_NAME, "Wrong verbosity level", verbosity); res = ssh_set_log_level (opt->value); if (res == SSH_ERROR) guile_ssh_error1 (FUNC_NAME, "Could not set log verbosity", verbosity); return SCM_UNDEFINED; } #undef FUNC_NAME SCM_DEFINE (guile_ssh_get_log_verbosity, "get-log-verbosity", 0, 0, 0, (void), "\ Get global log verbosity value.\ ") { return gssh_symbol_to_scm (log_verbosity, ssh_get_log_level ()); } static void _gssh_log (const char* c_prefix, int c_priority, const char* c_function_name, const char* msg, SCM args) { SCM prefix = scm_from_locale_string (c_prefix); SCM message = scm_from_locale_string (msg); SCM priority = scm_from_int (c_priority); SCM function = scm_from_locale_string (c_function_name); SCM str_obj = SCM_BOOL_F; if (c_priority > ssh_get_log_level ()) return; if (args != SCM_UNDEFINED) { str_obj = scm_object_to_string (args, SCM_UNDEFINED); message = scm_string_append (scm_list_n (prefix, scm_from_locale_string (" "), message, scm_from_locale_string (": "), str_obj, SCM_UNDEFINED)); } else { message = scm_string_append (scm_list_n (prefix, scm_from_locale_string (" "), message, SCM_UNDEFINED)); } SCM userdata = guile_ssh_get_log_userdata (); scm_call_4 (logging_callback, priority, function, message, userdata); scm_remember_upto_here_1 (str_obj); scm_remember_upto_here_1 (args); scm_remember_upto_here_1 (prefix); scm_remember_upto_here_1 (message); scm_remember_upto_here_1 (function); scm_remember_upto_here_1 (userdata); } /* Write an error MESSAGE along with ARGS to the libssh log. */ void _gssh_log_error (const char* function_name, const char* msg, SCM args) { _gssh_log ("[GSSH ERROR]", SSH_LOG_NOLOG, function_name, msg, args); } void _gssh_log_error_format (const char* function_name, SCM args, const char* fmt, ...) { va_list arg; enum { MSG_SZ = 100 }; char msg[MSG_SZ]; va_start (arg, fmt); vsnprintf (msg, MSG_SZ, fmt, arg); va_end (arg); _gssh_log_error(function_name, msg, args); } void _gssh_log_warning (const char* function_name, const char* msg, SCM args) { _gssh_log ("[GSSH WARNING]", SSH_LOG_WARNING, function_name, msg, args); } #ifdef DEBUG void _gssh_log_debug (const char* function_name, const char* msg, SCM args) { char *c_str; _gssh_log ("[GSSH DEBUG]", SSH_LOG_FUNCTIONS, function_name, msg, args); } void _gssh_log_debug1 (const char* function_name, const char* msg) { _gssh_log ("[GSSH DEBUG]", SSH_LOG_FUNCTIONS, function_name, msg, SCM_UNDEFINED); } void _gssh_log_debug_format(const char* function_name, SCM args, const char* fmt, ...) { va_list arg; enum { MSG_SZ = 100 }; char msg[MSG_SZ]; va_start (arg, fmt); vsnprintf (msg, MSG_SZ, fmt, arg); va_end (arg); _gssh_log_debug(function_name, msg, args); } #else #define _gssh_log_debug_format(function_name, args, fmt, ...) #endif /* ifdef DEBUG */ /* Initialization */ void init_log_func (void) { #include "log.x" } /* log.c ends here */ guile-ssh-0.18.0/libguile-ssh/log.h000066400000000000000000000035231471416131000170220ustar00rootroot00000000000000/* Copyright (C) 2014 Artyom V. Poptsov * * This file is part of Guile-SSH. * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #ifndef __LOG_H__ #define __LOG_H__ #include "common.h" extern gssh_symbol_t log_verbosity[]; extern void _gssh_log_error (const char* function_name, const char* msg, SCM args); extern void _gssh_log_error_format (const char* function_name, SCM args, const char* fmt, ...); extern void _gssh_log_warning (const char* function_name, const char* msg, SCM args); #ifdef DEBUG extern void _gssh_log_debug (const char* function_name, const char* msg, SCM args); extern void _gssh_log_debug1 (const char* function_name, const char* msg); extern void _gssh_log_debug_format(const char* function_name, SCM args, const char* fmt, ...); #else # define _gssh_log_debug(function_name, msg, args) # define _gssh_log_debug1(function_name, msg) # define _gssh_log_debug_format(function_name, args, fmt, ...) #endif /* ifdef DEBUG */ void log_backtrace (const char* function_name); extern void init_log_func (void); #endif /* ifndef __LOG_H__ */ /* log.h ends here */ guile-ssh-0.18.0/libguile-ssh/message-func.c000066400000000000000000000425661471416131000206230ustar00rootroot00000000000000/* message-func.c -- Functions for working with SSH messages. * * Copyright (C) 2013, 2014 Artyom V. Poptsov * * This file is part of Guile-SSH * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #include #include #include #include #include "common.h" #include "channel-type.h" #include "message-type.h" #include "message-func.h" #include "key-type.h" #include "error.h" #include "log.h" /* Procedures that are used for replying on requests. */ SCM_DEFINE (guile_ssh_message_reply_default, "message-reply-default", 1, 0, 0, (SCM msg), "\ Reduced version of the reply default that only reply with \ SSH_MSG_UNIMPLEMENTED.\n\ \n\ Return value is undefined.\ ") #define FUNC_NAME s_guile_ssh_message_reply_default { gssh_message_t* msg_data = gssh_message_from_scm (msg); int res = ssh_message_reply_default (msg_data->message); _gssh_log_debug_format(FUNC_NAME, msg, "result: %d", res); if (res != SSH_OK) guile_ssh_error1 (FUNC_NAME, "Unable to reply", msg); return SCM_UNDEFINED; } #undef FUNC_NAME SCM_DEFINE (guile_ssh_message_service_reply_success, "message-service-reply-success", 1, 0, 0, (SCM msg), "\ Reply with \"success\" status on the service-request message MSG.\n\ Return value is undefined.\ ") #define FUNC_NAME s_guile_ssh_message_service_reply_success { gssh_message_t* msg_data = gssh_message_from_scm (msg); int res = ssh_message_service_reply_success (msg_data->message); _gssh_log_debug_format(FUNC_NAME, msg, "result: %d", res); if (res != SSH_OK) guile_ssh_error1 (FUNC_NAME, "Unable to reply", msg); return SCM_UNDEFINED; } #undef FUNC_NAME SCM_DEFINE (guile_ssh_message_auth_reply_success, "message-auth-reply-success", 2, 0, 0, (SCM msg, SCM partial_p), "\ Reply with \"success\" on the auth-request message MSG.\n\ Return value is undefined.\ ") #define FUNC_NAME s_guile_ssh_message_auth_reply_success { gssh_message_t* msg_data = gssh_message_from_scm (msg); int c_partial_p = scm_to_bool (partial_p); int res = ssh_message_auth_reply_success (msg_data->message, c_partial_p); _gssh_log_debug_format(FUNC_NAME, msg, "result: %d", res); if (res != SSH_OK) { guile_ssh_error1 (FUNC_NAME, "Unable to reply", scm_list_2 (msg, partial_p)); } return SCM_UNDEFINED; } #undef FUNC_NAME SCM_DEFINE (guile_ssh_message_auth_reply_public_key_ok, "message-auth-reply-public-key-ok", 1, 0, 0, (SCM msg), "\ Reply OK on the public key auth-request message MSG.\n\ Return value is undefined.\ ") #define FUNC_NAME s_guile_ssh_message_auth_reply_public_key_ok { gssh_message_t* msg_data = gssh_message_from_scm (msg); int res = ssh_message_auth_reply_pk_ok_simple (msg_data->message); _gssh_log_debug_format(FUNC_NAME, msg, "result: %d", res); if (res != SSH_OK) guile_ssh_error1 (FUNC_NAME, "Unable to reply", msg); return SCM_UNDEFINED; } #undef FUNC_NAME SCM_DEFINE (guile_ssh_message_channel_request_reply_success, "message-channel-request-reply-success", 1, 0, 0, (SCM msg), "\ TODO: Add description.\n\ Return value is undefined.\ ") #define FUNC_NAME s_guile_ssh_message_channel_request_reply_success { gssh_message_t* msg_data = gssh_message_from_scm (msg); int res = ssh_message_channel_request_reply_success (msg_data->message); _gssh_log_debug_format(FUNC_NAME, msg, "result: %d", res); if (res != SSH_OK) guile_ssh_error1 (FUNC_NAME, "Unable to reply", msg); return SCM_UNDEFINED; } #undef FUNC_NAME SCM_DEFINE (guile_ssh_message_channel_request_open_reply_accept, "message-channel-request-open-reply-accept", 1, 0, 0, (SCM msg), "\ Accept open-channel request.\n\ Return a new SSH channel.\ ") { gssh_message_t* msg_data = gssh_message_from_scm (msg); ssh_channel ch; ch = ssh_message_channel_request_open_reply_accept (msg_data->message); if (! ch) return SCM_BOOL_F; SCM channel = ssh_channel_to_scm (ch, msg_data->session, SCM_RDNG | SCM_WRTNG); SCM_SET_CELL_TYPE (channel, SCM_CELL_TYPE (channel) | SCM_OPN); return channel; } SCM_DEFINE (gssh_message_global_request_reply_success, "message-global-request-reply-success", 2, 0, 0, (SCM msg, SCM bound_port), "") #define FUNC_NAME s_gssh_message_global_request_reply_success { gssh_message_t* md = gssh_message_from_scm (msg); int res; SCM_ASSERT (scm_is_unsigned_integer (bound_port, 0, UINT16_MAX), bound_port, SCM_ARG2, FUNC_NAME); res = ssh_message_global_request_reply_success (md->message, scm_to_uint16 (bound_port)); _gssh_log_debug_format(FUNC_NAME, scm_list_2 (msg, bound_port), "result: %d", res); if (res != SSH_OK) { guile_ssh_error1 (FUNC_NAME, "Unable to reply", scm_list_2 (msg, bound_port)); } return SCM_UNDEFINED; } #undef FUNC_NAME static gssh_symbol_t req_types[] = { { "request-auth", SSH_REQUEST_AUTH }, { "request-channel-open", SSH_REQUEST_CHANNEL_OPEN }, { "request-channel", SSH_REQUEST_CHANNEL }, { "request-service", SSH_REQUEST_SERVICE }, { "request-global", SSH_REQUEST_GLOBAL }, { NULL, -1 } }; static gssh_symbol_t req_auth_subtypes[] = { { "auth-method-unknown", SSH_AUTH_METHOD_UNKNOWN }, { "auth-method-none", SSH_AUTH_METHOD_NONE }, { "auth-method-password", SSH_AUTH_METHOD_PASSWORD }, { "auth-method-publickey", SSH_AUTH_METHOD_PUBLICKEY }, { "auth-method-hostbased", SSH_AUTH_METHOD_HOSTBASED }, { "auth-method-interactive", SSH_AUTH_METHOD_INTERACTIVE }, { NULL, -1 } }; static gssh_symbol_t req_channel_subtypes[] = { { "channel-request-unknown", SSH_CHANNEL_REQUEST_UNKNOWN }, { "channel-request-pty", SSH_CHANNEL_REQUEST_PTY }, { "channel-request-exec", SSH_CHANNEL_REQUEST_EXEC }, { "channel-request-shell", SSH_CHANNEL_REQUEST_SHELL }, { "channel-request-env", SSH_CHANNEL_REQUEST_ENV }, { "channel-request-subsystem", SSH_CHANNEL_REQUEST_SUBSYSTEM }, { "channel-request-window-change", SSH_CHANNEL_REQUEST_WINDOW_CHANGE }, { NULL, -1 } }; static gssh_symbol_t req_channel_open_subtypes[] = { { "channel-unknown", SSH_CHANNEL_UNKNOWN }, { "channel-session", SSH_CHANNEL_SESSION }, { "channel-direct-tcpip", SSH_CHANNEL_DIRECT_TCPIP }, { "channel-forwarded-tcpip", SSH_CHANNEL_FORWARDED_TCPIP }, { "channel-x11", SSH_CHANNEL_X11 }, { NULL, -1 } }; static gssh_symbol_t req_global_subtypes[] = { { "global-request-unknown", SSH_GLOBAL_REQUEST_UNKNOWN }, { "global-request-tcpip-forward", SSH_GLOBAL_REQUEST_TCPIP_FORWARD }, { "global-request-cancel-tcpip-forward", SSH_GLOBAL_REQUEST_CANCEL_TCPIP_FORWARD }, { NULL, -1 } }; static gssh_symbol_t pubkey_state_type[] = { { "error", SSH_PUBLICKEY_STATE_ERROR }, { "none", SSH_PUBLICKEY_STATE_NONE }, { "valid", SSH_PUBLICKEY_STATE_VALID }, { "wrong", SSH_PUBLICKEY_STATE_WRONG }, { NULL, -1 } }; /* Get a type of the message MSG as a list. car of the list is type of the message, cdr is a subtype. Return #f on error. */ static SCM _ssh_message_type_to_scm (ssh_message msg) { int type = ssh_message_type (msg); int subtype = ssh_message_subtype (msg); SCM scm_type = gssh_symbol_to_scm (req_types, type); SCM scm_subtype; switch (type) { case SSH_REQUEST_AUTH: scm_subtype = gssh_symbol_to_scm (req_auth_subtypes, subtype); return scm_list_2 (scm_type, scm_subtype); case SSH_REQUEST_CHANNEL_OPEN: scm_subtype = gssh_symbol_to_scm (req_channel_open_subtypes, subtype); return scm_list_2 (scm_type, scm_subtype); case SSH_REQUEST_CHANNEL: scm_subtype = gssh_symbol_to_scm (req_channel_subtypes, subtype); return scm_list_2 (scm_type, scm_subtype); case SSH_REQUEST_GLOBAL: scm_subtype = gssh_symbol_to_scm (req_global_subtypes, subtype); return scm_list_2 (scm_type, scm_subtype); case SSH_REQUEST_SERVICE: return scm_list_1 (scm_type); default: return SCM_BOOL_F; } } SCM_DEFINE (guile_ssh_message_get_type, "message-get-type", 1, 0, 0, (SCM msg), "\ Get type of the message MSG.\ ") { gssh_message_t* message_data = gssh_message_from_scm (msg); return _ssh_message_type_to_scm (message_data->message); } /* These procedures return a Scheme vector that represents a SSH request. The goal is to unify way of working with requests. */ /* = "#(" ")" */ static SCM get_auth_req (ssh_message msg, SCM scm_msg) /* FIXME: accept only SCM */ { SCM result = scm_c_make_vector (4, SCM_UNDEFINED); const char *user = ssh_message_auth_user (msg); const char *password = ssh_message_auth_password (msg); ssh_key public_key = ssh_message_auth_pubkey (msg); SCM pkey_state; if (user) SCM_SIMPLE_VECTOR_SET (result, 0, scm_from_locale_string (user)); else SCM_SIMPLE_VECTOR_SET (result, 0, SCM_BOOL_F); if (password) SCM_SIMPLE_VECTOR_SET (result, 1, scm_from_locale_string (password)); else SCM_SIMPLE_VECTOR_SET (result, 1, SCM_BOOL_F); SCM_SIMPLE_VECTOR_SET (result, 2, gssh_key_to_scm(public_key, scm_msg)); pkey_state = gssh_symbol_to_scm (pubkey_state_type, (int) ssh_message_auth_publickey_state (msg)); SCM_SIMPLE_VECTOR_SET (result, 3, pkey_state); return result; } /* = "#(" ")" */ static SCM get_pty_req (ssh_message msg) { SCM result = scm_c_make_vector (5, SCM_UNDEFINED); const char *term = ssh_message_channel_request_pty_term (msg); int w = ssh_message_channel_request_pty_width (msg); int h = ssh_message_channel_request_pty_height (msg); int pxw = ssh_message_channel_request_pty_pxwidth (msg); int pxh = ssh_message_channel_request_pty_pxheight (msg); SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_locale_string (term)); SCM_SIMPLE_VECTOR_SET(result, 1, scm_from_int (w)); SCM_SIMPLE_VECTOR_SET(result, 2, scm_from_int (h)); SCM_SIMPLE_VECTOR_SET(result, 3, scm_from_int (pxw)); SCM_SIMPLE_VECTOR_SET(result, 4, scm_from_int (pxh)); return result; } /* = "#(" ")" */ static SCM get_env_req (ssh_message msg) { SCM result = scm_c_make_vector (3, SCM_UNDEFINED); const char *name = ssh_message_channel_request_env_name (msg); const char *value = ssh_message_channel_request_env_value (msg); SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_locale_string (name)); SCM_SIMPLE_VECTOR_SET(result, 1, scm_from_locale_string (value)); return result; } /* = "#(" ")" */ static SCM get_exec_req (ssh_message msg) { SCM result = scm_c_make_vector (1, SCM_UNDEFINED); const char *cmd = ssh_message_channel_request_command (msg); SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_locale_string (cmd)); return result; } /* = "#(" ")" */ static SCM get_global_req (ssh_message msg) { SCM result = scm_c_make_vector (2, SCM_UNDEFINED); const char *addr = ssh_message_global_request_address (msg); int port = ssh_message_global_request_port (msg); SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_locale_string (addr)); SCM_SIMPLE_VECTOR_SET(result, 1, scm_from_int (port)); return result; } /* = "#(" ")" */ static SCM get_service_req (ssh_message msg) { SCM result = scm_c_make_vector (1, SCM_UNDEFINED); const char *req = ssh_message_service_service (msg); SCM_SIMPLE_VECTOR_SET(result, 0, scm_from_locale_string (req)); return result; } /* = "#(" ")" */ static SCM get_channel_open_req (ssh_message msg) { const char *orig = ssh_message_channel_request_open_originator (msg); int orig_port = ssh_message_channel_request_open_originator_port (msg); const char *dest = ssh_message_channel_request_open_destination (msg); int dest_port = ssh_message_channel_request_open_destination_port (msg); SCM result; if ((! orig) || (! dest)) return SCM_BOOL_F; result = scm_c_make_vector (4, SCM_UNDEFINED); SCM_SIMPLE_VECTOR_SET (result, 0, scm_from_locale_string (orig)); SCM_SIMPLE_VECTOR_SET (result, 1, scm_from_int (orig_port)); SCM_SIMPLE_VECTOR_SET (result, 2, scm_from_locale_string (dest)); SCM_SIMPLE_VECTOR_SET (result, 3, scm_from_int (dest_port)); return result; } static SCM get_subsystem_req (ssh_message msg) { const char* subsystem = ssh_message_channel_request_subsystem (msg); SCM result = SCM_BOOL_F; if (subsystem) { result = scm_c_make_vector (1, SCM_UNDEFINED); SCM_SIMPLE_VECTOR_SET (result, 0, scm_from_locale_string (subsystem)); } return result; } SCM_DEFINE (guile_ssh_message_get_req, "message-get-req", 1, 0, 0, (SCM msg), "\ Get a request object from the message MSG\ ") #define FUNC_NAME s_guile_ssh_message_get_req { gssh_message_t* message_data = gssh_message_from_scm (msg); ssh_message ssh_msg = message_data->message; int type = ssh_message_type (ssh_msg); switch (type) { case SSH_REQUEST_SERVICE: return get_service_req (ssh_msg); case SSH_REQUEST_AUTH: return get_auth_req (ssh_msg, msg); case SSH_REQUEST_CHANNEL_OPEN: { SCM res = get_channel_open_req (ssh_msg); if (scm_is_true (res)) return res; else guile_ssh_error1 (FUNC_NAME, "Wrong channel-open request", msg); } case SSH_REQUEST_CHANNEL: { int subtype = ssh_message_subtype (ssh_msg); switch (subtype) { case SSH_CHANNEL_REQUEST_PTY: return get_pty_req (ssh_msg); case SSH_CHANNEL_REQUEST_EXEC: return get_exec_req (ssh_msg); case SSH_CHANNEL_REQUEST_ENV: return get_env_req (ssh_msg); case SSH_CHANNEL_REQUEST_SUBSYSTEM: return get_subsystem_req (ssh_msg); default: guile_ssh_error1 (FUNC_NAME, "Wrong message subtype", scm_from_int (subtype)); } } case SSH_REQUEST_GLOBAL: return get_global_req (ssh_msg); default: guile_ssh_error1 (FUNC_NAME, "Wrong message type", gssh_symbol_to_scm (req_types, type)); } return SCM_BOOL_F; /* Never reached. */ } #undef FUNC_NAME /* A convenient wrapper for `scm_member' that returns its result as int. */ static inline int _scm_member_p (SCM elem, SCM lst) { return scm_is_true (scm_member (elem, lst)); } SCM_DEFINE (guile_ssh_message_auth_set_methods_x, "message-auth-set-methods!", 2, 0, 0, (SCM msg, SCM methods_list), "\ Set authentication methods.\n\ Return value is undefined.\ ") #define FUNC_NAME s_guile_ssh_message_auth_set_methods_x { gssh_message_t* message_data = gssh_message_from_scm (msg); int methods = 0; int res; SCM_ASSERT (scm_list_p (methods_list), methods_list, SCM_ARG2, FUNC_NAME); if (_scm_member_p (scm_from_locale_symbol ("password"), methods_list)) methods |= SSH_AUTH_METHOD_PASSWORD; if (_scm_member_p (scm_from_locale_symbol ("public-key"), methods_list)) methods |= SSH_AUTH_METHOD_PUBLICKEY; if (_scm_member_p (scm_from_locale_symbol ("interactive"), methods_list)) methods |= SSH_AUTH_METHOD_INTERACTIVE; if (_scm_member_p (scm_from_locale_symbol ("host-based"), methods_list)) methods |= SSH_AUTH_METHOD_HOSTBASED; res = ssh_message_auth_set_methods (message_data->message, methods); _gssh_log_debug_format(FUNC_NAME, scm_list_2 (msg, methods_list), "result: %d", res); if (res != SSH_OK) { guile_ssh_error1 (FUNC_NAME, "Unable to set auth methods", scm_list_2 (msg, methods_list)); } return SCM_UNDEFINED; } #undef FUNC_NAME SCM_DEFINE (guile_ssh_message_get_session, "message-get-session", 1, 0, 0, (SCM message), "\ Get the session from which the MESSAGE was received. Return the session.\ ") { gssh_message_t* md = gssh_message_from_scm (message); return md->session; } void init_message_func (void) { #include "message-func.x" } /* message-func.c ends here */ guile-ssh-0.18.0/libguile-ssh/message-func.h000066400000000000000000000021121471416131000206070ustar00rootroot00000000000000/* Copyright (C) 2013 Artyom V. Poptsov * * This file is part of Guile-SSH * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #ifndef __MESSAGE_FUNC_H__ #define __MESSAGE_FUNC_H__ #include extern SCM guile_ssh_message_reply_default (SCM arg1); extern SCM guile_ssh_message_get_type (SCM arg1); extern SCM guile_ssh_message_get_session (SCM arg1); extern void init_message_func (void); #endif /* ifndef __MESSAGE_FUNC_H__ */ /* message-func.h ends here */ guile-ssh-0.18.0/libguile-ssh/message-main.c000066400000000000000000000017621471416131000206050ustar00rootroot00000000000000/* message-main.c -- SSH message. * * Copyright (C) 2013 Artyom V. Poptsov * * This file is part of Guile-SSH * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #include #include "message-type.h" #include "message-func.h" #include "threads.h" void init_message (void) { init_message_type (); init_message_func (); init_pthreads (); } /* message-main.c ends here */ guile-ssh-0.18.0/libguile-ssh/message-type.c000066400000000000000000000060451471416131000206410ustar00rootroot00000000000000/* message-type.c -- SSH message smob. * * Copyright (C) 2013-2021 Artyom V. Poptsov * * This file is part of Guile-SSH * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #include #include #include #include #include "message-type.h" #include "message-func.h" #include "common.h" static const char* GSSH_MESSAGE_TYPE_NAME = "message"; scm_t_bits message_tag; /* Smob tag. */ /* GC callbacks. */ static SCM _mark (SCM message) { gssh_message_t* md = gssh_message_from_scm (message); return md->session; } static size_t _free (SCM message) { gssh_message_t* md = (gssh_message_t *) SCM_SMOB_DATA (message); ssh_message_free (md->message); return 0; } /* Printing procedure. */ static int _print (SCM smob, SCM port, scm_print_state *pstate) { SCM msg_type = guile_ssh_message_get_type (smob); scm_puts ("#", port); return 1; } SCM _equalp (SCM x1, SCM x2) { return compare_objects(x1, x2, (converter_t) gssh_message_from_scm); } /* Predicates. */ SCM_DEFINE (guile_ssh_is_message_p, "message?", 1, 0, 0, (SCM x), "\ Return #t if X a SSH message, #f otherwise.\ ") { return scm_from_bool (SCM_SMOB_PREDICATE (message_tag, x)); } /* Helper procedures. */ gssh_message_t* make_gssh_message () { return (gssh_message_t *) scm_gc_malloc (sizeof (gssh_message_t), GSSH_MESSAGE_TYPE_NAME); } SCM gssh_message_to_scm (const gssh_message_t* message) { SCM smob; SCM_NEWSMOB (smob, message_tag, message); return smob; } SCM ssh_message_to_scm (const ssh_message message, SCM session) { gssh_message_t* message_data = make_gssh_message (); message_data->message = message; message_data->session = session; return gssh_message_to_scm (message_data); } /* Convert X to a SSH message. */ gssh_message_t * gssh_message_from_scm (SCM x) { scm_assert_smob_type (message_tag, x); return (gssh_message_t *) SCM_SMOB_DATA (x); } /* Message smob initialization. */ void init_message_type (void) { message_tag = scm_make_smob_type (GSSH_MESSAGE_TYPE_NAME, sizeof (gssh_message_t)); set_smob_callbacks (message_tag, _mark, _free, _equalp, _print); #include "message-type.x" } /* message-type.c ends here */ guile-ssh-0.18.0/libguile-ssh/message-type.h000066400000000000000000000027771471416131000206560ustar00rootroot00000000000000/* Copyright (C) 2013-2021 Artyom V. Poptsov * * This file is part of Guile-SSH. * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #ifndef __MESSAGE_TYPE_H__ #define __MESSAGE_TYPE_H__ #include #include extern scm_t_bits message_tag; /* Smob data. */ struct gssh_message { /* Reference to the parent session. We need to keep the reference to prevent the session from premature freeing by the GC. */ SCM session; ssh_message message; }; typedef struct gssh_message gssh_message_t; extern void init_message_type (void); /* Helper procedures. */ extern gssh_message_t* make_gssh_message (); extern SCM ssh_message_to_scm (const ssh_message message, SCM session); extern SCM gssh_message_to_scm (const gssh_message_t* message); extern gssh_message_t* gssh_message_from_scm (SCM message); #endif /* ifndef __MESSAGE_TYPE_H__ */ /* message-type.h ends here */ guile-ssh-0.18.0/libguile-ssh/server-func.c000066400000000000000000000205641471416131000204770ustar00rootroot00000000000000/* server-func.c -- Functions for working with SSH server. * * Copyright (C) 2013, 2014 Artyom V. Poptsov * * This file is part of Guile-SSH * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #include #include #include #include #include "common.h" #include "session-type.h" #include "session-func.h" #include "server-type.h" #include "message-type.h" #include "error.h" #include "log.h" /* Guile SSH specific options that are aimed to unificate the way of server configuration. */ enum gssh_server_options { /* Should not intersect with options from SSH server API. */ GSSH_BIND_OPTIONS_BLOCKING_MODE = 100 }; /* SSH server options mapping to Guile symbols. */ gssh_symbol_t server_options[] = { { "bindaddr", SSH_BIND_OPTIONS_BINDADDR }, { "bindport", SSH_BIND_OPTIONS_BINDPORT }, { "hostkey", SSH_BIND_OPTIONS_HOSTKEY }, { "dsakey", SSH_BIND_OPTIONS_DSAKEY }, { "rsakey", SSH_BIND_OPTIONS_RSAKEY }, { "banner", SSH_BIND_OPTIONS_BANNER }, { "log-verbosity", SSH_BIND_OPTIONS_LOG_VERBOSITY }, { "blocking-mode", GSSH_BIND_OPTIONS_BLOCKING_MODE }, { NULL, -1 } }; /* Convert VALUE to a string and pass it to ssh_bind_options_set */ static inline int set_string_opt (ssh_bind bind, int type, SCM value) { char *str; int ret; SCM_ASSERT (scm_is_string (value), value, SCM_ARG3, "server-set!"); str = scm_to_locale_string (value); ret = ssh_bind_options_set (bind, type, str); free (str); return ret; } /* Convert VALUE to int32 and pass it to ssh_bind_options_set */ static inline int set_int32_opt (ssh_bind bind, int type, SCM value) { int32_t c_value; SCM_ASSERT (scm_is_integer (value), value, SCM_ARG3, "server-set!"); c_value = scm_to_int (value); return ssh_bind_options_set (bind, type, &c_value); } /* Convert VALUE to uint32 and pass it to ssh_bind_options_set */ static inline int set_uint32_opt (ssh_bind bind, int type, SCM value) { unsigned int c_value; SCM_ASSERT (scm_is_unsigned_integer (value, 0, UINT32_MAX), value, SCM_ARG3, "server-set!"); c_value = scm_to_uint32 (value); return ssh_bind_options_set (bind, type, &c_value); } /* Set a SSH bind BIND to blocking/nonblocking mode according to value VALUE. VALUE is expected to be #t or #f. Always return SSH_OK. */ static inline int set_blocking_mode (ssh_bind bind, SCM value) { SCM_ASSERT (scm_is_bool (value), value, SCM_ARG2, "server-set!"); ssh_bind_set_blocking (bind, scm_to_bool (value)); return SSH_OK; } /* Convert Scheme symbol to libssh constant and set the corresponding option to the value of the constant. */ static inline int set_sym_opt (ssh_bind bind, int type, gssh_symbol_t *sm, SCM value) { const gssh_symbol_t *opt = gssh_symbol_from_scm (sm, value); if (! opt) guile_ssh_error1 ("server-set!", "Wrong value", value); return ssh_bind_options_set (bind, type, &opt->value); } static int set_option (ssh_bind bind, int type, SCM value) { switch (type) { case SSH_BIND_OPTIONS_BINDADDR: case SSH_BIND_OPTIONS_HOSTKEY: case SSH_BIND_OPTIONS_DSAKEY: case SSH_BIND_OPTIONS_RSAKEY: case SSH_BIND_OPTIONS_BANNER: return set_string_opt (bind, type, value); case SSH_BIND_OPTIONS_BINDPORT: return set_uint32_opt (bind, type, value); case SSH_BIND_OPTIONS_LOG_VERBOSITY: return set_sym_opt (bind, type, log_verbosity, value); case GSSH_BIND_OPTIONS_BLOCKING_MODE: return set_blocking_mode (bind, value); default: guile_ssh_error1 ("server-set!", "Operation is not supported yet: %a~%", scm_from_int (type)); } return -1; /* ERROR */ } SCM_DEFINE (guile_ssh_server_set_x, "server-set!", 3, 0, 0, (SCM server, SCM option, SCM value), "\ Set a SSH server option.\n\ Return value is undefined.\ ") #define FUNC_NAME s_guile_ssh_server_set_x { gssh_server_t *server_data = gssh_server_from_scm (server); const gssh_symbol_t *opt; /* Server option */ int res; SCM_ASSERT (scm_is_symbol (option), option, SCM_ARG2, FUNC_NAME); opt = gssh_symbol_from_scm (server_options, option); if (! opt) guile_ssh_error1 (FUNC_NAME, "No such option", option); res = set_option (server_data->bind, opt->value, value); _gssh_log_debug_format(FUNC_NAME, scm_list_3 (server, option, value), "result: %d", res); if (res != SSH_OK) { guile_ssh_error1 (FUNC_NAME, "Unable to set the option", scm_list_3 (server, option, value)); } server_data->options = scm_assoc_set_x (server_data->options, option, value); scm_remember_upto_here_1 (server); return SCM_UNDEFINED; } #undef FUNC_NAME SCM_DEFINE (guile_ssh_server_get, "server-get", 2, 0, 0, (SCM server, SCM option), "\ Get a Guile-SSH server option. Return option value, or `#f' if option is\n\ not set. Throw `guile-ssh-error' on error.\ ") #define FUNC_NAME s_guile_ssh_server_get { const gssh_server_t *sd = gssh_server_from_scm (server); const gssh_symbol_t *opt = gssh_symbol_from_scm (server_options, option); if (! opt) guile_ssh_error1 (FUNC_NAME, "No such option", option); return scm_assoc_ref (sd->options, option); } #undef FUNC_NAME SCM_DEFINE (guile_ssh_server_listen, "server-listen", 1, 0, 0, (SCM server), "\ Start listening to the socket.\n\ Return value is undefined.\ ") #define FUNC_NAME s_guile_ssh_server_listen { gssh_server_t *server_data = gssh_server_from_scm (server); int res = ssh_bind_listen (server_data->bind); _gssh_log_debug_format(FUNC_NAME, server, "result: %d", res); if (res != SSH_OK) guile_ssh_error1 (FUNC_NAME, "Couldn't listen the socket.", server); return SCM_UNDEFINED; } #undef FUNC_NAME SCM_DEFINE (guile_ssh_server_accept, "server-accept", 1, 0, 0, (SCM server), "\ Accept an incoming ssh connection to the SERVER.\n\ Throw `guile-ssh-error' on error. Return a new SSH session.\ ") #define FUNC_NAME s_guile_ssh_server_accept { gssh_server_t *server_data = gssh_server_from_scm (server); SCM session = guile_ssh_make_session (); gssh_session_t *session_data = gssh_session_from_scm (session); int res = ssh_bind_accept (server_data->bind, session_data->ssh_session); _gssh_log_debug_format(FUNC_NAME, server, "result: %d", res); if (res != SSH_OK) guile_ssh_session_error1 (FUNC_NAME, session_data->ssh_session, session); return session; } #undef FUNC_NAME SCM_DEFINE (guile_ssh_server_handle_key_exchange, "server-handle-key-exchange", 1, 0, 0, (SCM session), "\ Handle key exchange for a server SERVER and setup encryption.\n\ Return value is undefined.\ ") #define FUNC_NAME s_guile_ssh_server_handle_key_exchange { gssh_session_t *session_data = gssh_session_from_scm (session); int res = ssh_handle_key_exchange (session_data->ssh_session); _gssh_log_debug_format(FUNC_NAME, session, "result: %d", res); if (res != SSH_OK) guile_ssh_session_error1 (FUNC_NAME, session_data->ssh_session, session); return SCM_UNDEFINED; } #undef FUNC_NAME SCM_DEFINE (guile_ssh_server_message_get, "server-message-get", 1, 0, 0, (SCM session), "\ Get a message.\ ") { gssh_session_t *session_data = gssh_session_from_scm (session); ssh_message message = ssh_message_get (session_data->ssh_session); if (message == NULL) return SCM_BOOL_F; else return ssh_message_to_scm (message, session); } /* Initialize server related functions. */ void init_server_func (void) { #include "server-func.x" } /* server-func.c ends here */ guile-ssh-0.18.0/libguile-ssh/server-func.h000066400000000000000000000021231471416131000204730ustar00rootroot00000000000000/* Copyright (C) 2013 Artyom V. Poptsov * * This file is part of Guile-SSH * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #ifndef __SERVER_FUNC_H__ #define __SERVER_FUNC_H__ #include #include extern gssh_symbol_t server_options[]; extern SCM guile_ssh_server_set_x (SCM arg1, SCM arg2, SCM arg3); extern SCM guile_ssh_server_accept (SCM arg1); extern void init_server_func (void); #endif /* ifndef __SERVER_FUNC_H__ */ /* server-func.h ends here */ guile-ssh-0.18.0/libguile-ssh/server-main.c000066400000000000000000000017521471416131000204660ustar00rootroot00000000000000/* server-main.c -- SSH server. * * Copyright (C) 2013 Artyom V. Poptsov * * This file is part of Guile-SSH * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #include #include "server-type.h" #include "server-func.h" #include "threads.h" void init_server (void) { init_server_type (); init_server_func (); init_pthreads (); } /* server-main.c ends here */ guile-ssh-0.18.0/libguile-ssh/server-type.c000066400000000000000000000072371471416131000205270ustar00rootroot00000000000000/* server-type.c -- SSH server smob. * * Copyright (C) 2013, 2014, 2015, 2016 Artyom V. Poptsov * * This file is part of Guile-SSH * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #include #include #include #include #include "common.h" #include "server-type.h" #include "server-func.h" static const char* GSSH_SERVER_TYPE_NAME = "server"; scm_t_bits server_tag; /* Smob tag. */ /* GC callbacks */ static SCM _mark (SCM server) { gssh_server_t *sd = gssh_server_from_scm (server); return sd->options; } static size_t _free (SCM server) { gssh_server_t *sd = (gssh_server_t *) SCM_SMOB_DATA (server); ssh_bind_free (sd->bind); return 0; } static SCM _equalp (SCM x1, SCM x2) { return compare_objects(x1, x2, (converter_t) gssh_server_from_scm); } static int _print (SCM server, SCM port, scm_print_state *pstate) { gssh_server_t *sd = gssh_server_from_scm (server); SCM bindaddr = scm_assoc_ref (sd->options, gssh_symbol_to_scm (server_options, SSH_BIND_OPTIONS_BINDADDR)); SCM bindport = scm_assoc_ref (sd->options, gssh_symbol_to_scm (server_options, SSH_BIND_OPTIONS_BINDPORT)); scm_puts ("#', port); return 1; } gssh_server_t* make_gssh_server () { return (gssh_server_t *) scm_gc_malloc (sizeof (gssh_server_t), GSSH_SERVER_TYPE_NAME); } /* Smob specific procedures. */ SCM_DEFINE (guile_ssh_make_server, "%make-server", 0, 0, 0, (), "Make a new SSH server.") { SCM smob; gssh_server_t *server_data = make_gssh_server (); server_data->bind = ssh_bind_new (); server_data->options = SCM_EOL; SCM_NEWSMOB (smob, server_tag, server_data); return smob; } /* Predicates. */ SCM_DEFINE (guile_ssh_is_server_p, "server?", 1, 0, 0, (SCM x), "Return #t if X is a SSH server, #f otherwise.") { return scm_from_bool (SCM_SMOB_PREDICATE (server_tag, x)); } /* Helper procedures. */ /* Convert X to a SSH server. */ gssh_server_t * gssh_server_from_scm (SCM x) { scm_assert_smob_type (server_tag, x); return (gssh_server_t *) SCM_SMOB_DATA (x); } /* Server smob initialization. */ void init_server_type (void) { server_tag = scm_make_smob_type (GSSH_SERVER_TYPE_NAME, sizeof (gssh_server_t)); set_smob_callbacks (server_tag, _mark, _free, _equalp, _print); #include "server-type.x" } /* server-type.c ends here */ guile-ssh-0.18.0/libguile-ssh/server-type.h000066400000000000000000000024001471416131000205170ustar00rootroot00000000000000/* Copyright (C) 2013 Artyom V. Poptsov * * This file is part of Guile-SSH. * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #ifndef __SERVER_TYPE_H__ #define __SERVER_TYPE_H__ #include #include extern scm_t_bits server_tag; /* Smob data. */ struct gssh_server { ssh_bind bind; SCM options; }; typedef struct gssh_server gssh_server_t; extern gssh_server_t* make_gssh_server (); extern SCM guile_ssh_is_server_p (SCM arg1); extern void init_server_type (void); /* Helper procedures. */ extern gssh_server_t* gssh_server_from_scm (SCM x); #endif /* ifndef __SERVER_TYPE_H__ */ /* server-type.h ends here */ guile-ssh-0.18.0/libguile-ssh/session-func.c000066400000000000000000000563701471416131000206600ustar00rootroot00000000000000/* session-func.c -- Functions for working with SSH session. * * Copyright (C) 2013-2024 Artyom V. Poptsov * Copyright (C) 2024 Peter Tillemans * * This file is part of Guile-SSH. * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #include #include #include #include #include #include #include "common.h" #include "error.h" #include "session-type.h" #include "key-type.h" #include "message-type.h" #include "log.h" #include "callbacks.h" /* Guile SSH specific options that are aimed to unificate the way of session configuration. */ enum gssh_session_options { /* Should not intersect with options from SSH session API. */ GSSH_OPTIONS_CALLBACKS = 100 }; /* SSH options mapping to Guile symbols. */ static gssh_symbol_t session_options[] = { { "host", SSH_OPTIONS_HOST }, { "port", SSH_OPTIONS_PORT }, { "fd", SSH_OPTIONS_FD }, { "bindaddr", SSH_OPTIONS_BINDADDR }, { "user", SSH_OPTIONS_USER }, { "ssh-dir", SSH_OPTIONS_SSH_DIR }, { "identity", SSH_OPTIONS_IDENTITY }, { "knownhosts", SSH_OPTIONS_KNOWNHOSTS }, { "timeout", SSH_OPTIONS_TIMEOUT }, { "timeout-usec", SSH_OPTIONS_TIMEOUT_USEC }, { "ssh1", SSH_OPTIONS_SSH1 }, { "ssh2", SSH_OPTIONS_SSH2 }, { "log-verbosity", SSH_OPTIONS_LOG_VERBOSITY }, { "ciphers-c-s", SSH_OPTIONS_CIPHERS_C_S }, { "ciphers-s-c", SSH_OPTIONS_CIPHERS_S_C }, { "compression-c-s", SSH_OPTIONS_COMPRESSION_C_S }, { "compression-s-c", SSH_OPTIONS_COMPRESSION_S_C }, { "proxycommand", SSH_OPTIONS_PROXYCOMMAND }, { "stricthostkeycheck", SSH_OPTIONS_STRICTHOSTKEYCHECK }, { "compression", SSH_OPTIONS_COMPRESSION }, { "compression-level", SSH_OPTIONS_COMPRESSION_LEVEL }, #if HAVE_LIBSSH_0_9 /* This option was added only in 0.9.0 (commit 79f0c38fbd767f578d7b87fae15fb64faad32aab) */ { "process-config?", SSH_OPTIONS_PROCESS_CONFIG }, #else # warning Option SSH_OPTIONS_PROCESS_CONFIG is not available. #endif #if HAVE_LIBSSH_0_8_1 { "nodelay", SSH_OPTIONS_NODELAY }, #else # warning Option SSH_OPTIONS_NODELAY is not available. #endif #if HAVE_LIBSSH_0_8_3 /* Preferred public key algorithms to be used for authentication (comma-separated list as a string). Example: "ssh-rsa,rsa-sha2-256,ssh-dss,ecdh-sha2-nistp256" This option was added to the libssh in 4521ab73b6858efa0083ac96a1775719b1f649ae */ { "public-key-accepted-types", SSH_OPTIONS_PUBLICKEY_ACCEPTED_TYPES }, #else # warning Option SSH_OPTIONS_PUBLICKEY_ACCEPTED_TYPES is not available. #endif #if HAVE_LIBSSH_0_10 {"rsa-min-size", SSH_OPTIONS_RSA_MIN_SIZE }, #else # warning Option SSH_OPTIONS_RSA_MIN_SIZE is not available. #endif { "callbacks", GSSH_OPTIONS_CALLBACKS }, { NULL, -1 } }; /* Create a new session. */ SCM_DEFINE (guile_ssh_make_session, "%make-session", 0, 0, 0, (), "\ Create a new session.\ ") { gssh_session_t *session_data = make_gssh_session (); session_data->ssh_session = ssh_new (); if (session_data->ssh_session == NULL) return SCM_BOOL_F; session_data->callbacks = SCM_BOOL_F; session_data->channels = SCM_EOL; return gssh_session_to_scm (session_data); } /* Predicates */ SCM_DEFINE (guile_ssh_is_session_p, "session?", 1, 0, 0, (SCM x), "\ Return #t if X is a SSH session, #f otherwise.\ ") { return scm_from_bool (SCM_SMOB_PREDICATE (session_tag, x)); } /* Blocking flush of the outgoing buffer. Return on of the following symbols: 'ok, 'error. 'again. Asserts: - Return value of `ssh_blocking_flush' is one of the valid constants described in libssh.h */ SCM_DEFINE (guile_ssh_blocking_flush, "blocking-flush!", 2, 0, 0, (SCM session_smob, SCM timeout), "\ Blocking flush of the outgoing buffer.\n\ Return on of the following symbols: 'ok, 'error, 'again.\ ") #define FUNC_NAME s_guile_ssh_blocking_flush { gssh_session_t *data = gssh_session_from_scm (session_smob); int c_timeout; /* Timeout */ int res; /* Result of a function call. */ /* Check types */ SCM_ASSERT (scm_is_integer (timeout), timeout, SCM_ARG2, FUNC_NAME); c_timeout = scm_to_int (timeout); res = ssh_blocking_flush (data->ssh_session, c_timeout); _gssh_log_debug_format (FUNC_NAME, scm_list_2 (session_smob, timeout), "result: %d", res); switch (res) { case SSH_OK: return scm_from_locale_symbol ("ok"); case SSH_AGAIN: return scm_from_locale_symbol ("again"); case SSH_ERROR: return scm_from_locale_symbol ("error"); default: /* Must not happen. */ _gssh_log_error_format (FUNC_NAME, scm_list_2 (session_smob, timeout), "Unknown result: %d", res); assert (0); return SCM_BOOL_F; } } #undef FUNC_NAME /* Set SSH session options */ /* Convert VALUE to a string and pass it to ssh_options_set */ static inline int set_string_opt (ssh_session session, int type, SCM value) { char *str; int ret; SCM_ASSERT (scm_is_string (value), value, SCM_ARG3, "session-set!"); str = scm_to_locale_string (value); ret = ssh_options_set (session, type, str); free (str); return ret; } /* Convert VALUE to uint64 and pass it to ssh_options_set */ static inline int set_uint64_opt (ssh_session session, int type, SCM value) { uint64_t c_value; SCM_ASSERT (scm_is_unsigned_integer (value, 0, UINT64_MAX), value, SCM_ARG3, "session-set!"); c_value = scm_to_uint64 (value); return ssh_options_set (session, type, &c_value); } /* Convert VALUE to uint32 and pass it to ssh_options_set */ static inline int set_uint32_opt (ssh_session session, int type, SCM value) { unsigned int c_value; SCM_ASSERT (scm_is_unsigned_integer (value, 0, UINT32_MAX), value, SCM_ARG3, "session-set!"); c_value = scm_to_uint32 (value); return ssh_options_set (session, type, &c_value); } /* Convert VALUE to int32 and pass it to ssh_options_set */ static inline int set_int32_opt (ssh_session session, int type, SCM value) { int32_t c_value; SCM_ASSERT (scm_is_integer (value), value, SCM_ARG3, "session-set!"); c_value = scm_to_int (value); return ssh_options_set (session, type, &c_value); } /* Convert VALUE to integer that represents a boolan value (0 considered as false, any other value is true), and pass it to ssh_options_set */ static inline int set_bool_opt (ssh_session session, int type, SCM value) { int32_t bool_value; SCM_ASSERT (scm_is_bool (value), value, SCM_ARG3, "session-set!"); bool_value = scm_to_bool (value); return ssh_options_set (session, type, &bool_value); } /* Convert VALUE to a socket file descriptor and pass it to ssh_options_set */ static inline int set_port_opt (ssh_session session, int type, SCM value) { socket_t sfd; /* Socket File Descriptor */ SCM_ASSERT (scm_port_p (value), value, SCM_ARG3, "session-set!"); sfd = scm_to_int (scm_fileno (value)); return ssh_options_set (session, type, &sfd); } /* Convert Scheme symbol to libssh constant and set the corresponding option to the value of the constant. */ static inline int set_sym_opt (ssh_session session, int type, gssh_symbol_t *sm, SCM value) { const gssh_symbol_t *opt = gssh_symbol_from_scm (sm, value); if (! opt) guile_ssh_error1 ("session-set!", "Wrong value", value); return ssh_options_set (session, type, &opt->value); } /* Callbacks. */ /* The callback procedure that meant to be called by libssh; the procedure in turn calls a specified Scheme procedure. USERDATA is a Guile-SSH session instance. */ static void libssh_global_request_callback (ssh_session session, ssh_message message, void *userdata) { SCM scm_session = (SCM) userdata; gssh_session_t *sd = gssh_session_from_scm (scm_session); SCM scm_callback = callback_ref (sd->callbacks, "global-request-callback"); SCM scm_userdata = callback_userdata_ref (sd->callbacks); SCM scm_message = ssh_message_to_scm (message, scm_session); scm_call_3 (scm_callback, scm_session, scm_message, scm_userdata); } /* The callback procedure that meant to be called by libssh to indicate the percentage of connection steps completed. The percentage is passed as STATUS. USERDATA is a Guile-SSH session instance. */ static void libssh_connect_status_callback (void *userdata, float status) { SCM scm_session = (SCM) userdata; gssh_session_t *sd = gssh_session_from_scm (scm_session); SCM scm_callback = callback_ref (sd->callbacks, "connect-status-callback"); SCM scm_userdata = callback_userdata_ref (sd->callbacks); scm_call_3 (scm_callback, scm_session, scm_from_double (status), scm_userdata); } /* Set libssh callbacks for a SESSION. The procedure expects CALLBACKS to be an alist object. Return SSH_OK if callbacks were set succesfully, SSH_ERROR otherwise. */ static int set_callbacks (SCM session, gssh_session_t *sd, SCM callbacks) { struct ssh_callbacks_struct *cb = (struct ssh_callbacks_struct *) scm_gc_malloc (sizeof (struct ssh_callbacks_struct), "ssh-callbacks"); SCM_ASSERT (scm_to_bool (scm_list_p (callbacks)), callbacks, SCM_ARG3, "session-set!"); sd->callbacks = callbacks; cb->userdata = session; if (callback_set_p (callbacks, "global-request-callback")) { callback_validate (session, callbacks, "global-request-callback"); cb->global_request_function = libssh_global_request_callback; } if (callback_set_p (callbacks, "connect-status-callback")) { callback_validate (session, callbacks, "connect-status-callback"); cb->connect_status_function = libssh_connect_status_callback; } ssh_callbacks_init (cb); scm_remember_upto_here_2 (session, callbacks); return ssh_set_callbacks (sd->ssh_session, cb); } /* Set an SSH session option. */ static int set_option (SCM scm_session, gssh_session_t* sd, int type, SCM value) { ssh_session session = sd->ssh_session; switch (type) { case SSH_OPTIONS_PORT: return set_uint32_opt (session, type, value); case SSH_OPTIONS_HOST: case SSH_OPTIONS_BINDADDR: case SSH_OPTIONS_USER: case SSH_OPTIONS_COMPRESSION: case SSH_OPTIONS_SSH_DIR: case SSH_OPTIONS_KNOWNHOSTS: case SSH_OPTIONS_IDENTITY: case SSH_OPTIONS_CIPHERS_C_S: case SSH_OPTIONS_CIPHERS_S_C: case SSH_OPTIONS_COMPRESSION_C_S: case SSH_OPTIONS_COMPRESSION_S_C: case SSH_OPTIONS_PROXYCOMMAND: #if HAVE_LIBSSH_0_8_3 case SSH_OPTIONS_PUBLICKEY_ACCEPTED_TYPES: #endif return set_string_opt (session, type, value); case SSH_OPTIONS_LOG_VERBOSITY: return set_sym_opt (session, type, log_verbosity, value); case SSH_OPTIONS_COMPRESSION_LEVEL: return set_int32_opt (session, type, value); case SSH_OPTIONS_TIMEOUT: case SSH_OPTIONS_TIMEOUT_USEC: return set_uint64_opt (session, type, value); case SSH_OPTIONS_SSH1: case SSH_OPTIONS_SSH2: case SSH_OPTIONS_STRICTHOSTKEYCHECK: #if HAVE_LIBSSH_0_9 /* This option was added only in 0.9.0 (commit 79f0c38fbd767f578d7b87fae15fb64faad32aab) */ case SSH_OPTIONS_PROCESS_CONFIG: #endif #if HAVE_LIBSSH_0_8_1 case SSH_OPTIONS_NODELAY: #endif return set_bool_opt (session, type, value); case SSH_OPTIONS_FD: return set_port_opt (session, type, value); case GSSH_OPTIONS_CALLBACKS: return set_callbacks (scm_session, sd, value); #if HAVE_LIBSSH_0_10 case SSH_OPTIONS_RSA_MIN_SIZE: return set_int32_opt (session, type, value); break; #endif default: guile_ssh_error1 ("session-set!", "Operation is not supported yet: %a~%", scm_from_int (type)); } return -1; /* ERROR */ } /* Set a SSH option. Return #t on success, #f on error. */ SCM_DEFINE (guile_ssh_session_set, "session-set!", 3, 0, 0, (SCM session, SCM option, SCM value), "\ Set a SSH option OPTION. Throw an guile-ssh-error on error.\n\ Return value is undefined.\ ") #define FUNC_NAME s_guile_ssh_session_set { gssh_session_t* data = gssh_session_from_scm (session); const gssh_symbol_t *opt; /* Session option */ int res; /* Result of a function call */ SCM_ASSERT (scm_is_symbol (option), option, SCM_ARG2, FUNC_NAME); opt = gssh_symbol_from_scm (session_options, option); if(! opt) guile_ssh_error1 (FUNC_NAME, "No such option", option); res = set_option (session, data, opt->value, value); _gssh_log_debug_format (FUNC_NAME, scm_list_3 (session, option, value), "result: %d", res); if (res != SSH_OK) { guile_ssh_error1 (FUNC_NAME, "Unable to set the option", scm_list_2 (option, value)); } scm_remember_upto_here_1 (session); return SCM_UNDEFINED; } #undef FUNC_NAME /* Options whose values can be requested through `session-get' */ static gssh_symbol_t session_options_getable[] = { { "host", SSH_OPTIONS_HOST }, { "port", SSH_OPTIONS_PORT }, { "user", SSH_OPTIONS_USER }, { "identity", SSH_OPTIONS_IDENTITY }, { "proxycommand", SSH_OPTIONS_PROXYCOMMAND }, { "callbacks", GSSH_OPTIONS_CALLBACKS }, { NULL, -1 } }; SCM_DEFINE (guile_ssh_session_get, "session-get", 2, 0, 0, (SCM session, SCM option), "\ Get value of the OPTION. Throw `guile-ssh-error' on an error.\ ") #define FUNC_NAME s_guile_ssh_session_get { gssh_session_t* sd = gssh_session_from_scm (session); const gssh_symbol_t *opt = NULL; SCM value = SCM_UNDEFINED; /*Value of the option */ int res = SSH_OK; SCM_ASSERT (scm_is_symbol (option), option, SCM_ARG2, FUNC_NAME); opt = gssh_symbol_from_scm (session_options_getable, option); if (! opt) guile_ssh_error1 (FUNC_NAME, "Wrong option", option); if (opt->value == SSH_OPTIONS_PORT) { unsigned int port; res = ssh_options_get_port (sd->ssh_session, &port); value = (res == SSH_OK) ? scm_from_int (port) : SCM_UNDEFINED; } else if (opt->value == GSSH_OPTIONS_CALLBACKS) { value = sd->callbacks; } else { char *c_value = NULL; res = ssh_options_get (sd->ssh_session, opt->value, &c_value); _gssh_log_debug_format (FUNC_NAME, scm_list_2 (session, option), "result: %d", res); value = (res == SSH_OK) ? scm_from_locale_string (c_value) : SCM_UNDEFINED; } if (res == SSH_ERROR) guile_ssh_error1 (FUNC_NAME, "Unable to get value of the option", option); scm_remember_upto_here_1 (option); return value; } #undef FUNC_NAME /* Asserts: - SESSION is a Guile-SSH session object. - FILE_NAME either a string or '#f' */ SCM_GSSH_DEFINE (gssh_session_parse_config, "%gssh-session-parse-config!", 2, (SCM session, SCM file_name)) #define FUNC_NAME s_gssh_session_parse_config { gssh_session_t *sd = gssh_session_from_scm (session); int res; char* c_file_name = NULL; SCM_ASSERT (scm_is_string (file_name) || (scm_is_bool (file_name) && scm_is_false (file_name)), file_name, SCM_ARG2, FUNC_NAME); scm_dynwind_begin (0); if (scm_is_string (file_name)) { c_file_name = scm_to_locale_string (file_name); scm_dynwind_free (c_file_name); } res = ssh_options_parse_config (sd->ssh_session, /* 'NULL' means that we should read the default '~/.ssh/config' file. */ c_file_name); _gssh_log_debug_format (FUNC_NAME, scm_list_2 (session, file_name), "result: %d", res); if (res != SSH_OK) { guile_ssh_error1 (FUNC_NAME, "Could not read the configuration file", scm_list_2 (session, file_name)); } scm_dynwind_end (); return SCM_UNDEFINED; } #undef FUNC_NAME /* Connect to the SSH server. Return one of the following symbols: 'ok, 'again, 'error Asserts: - Return value of `ssh_connect' is one of the valid constants described in libssh.h */ SCM_DEFINE (guile_ssh_connect_x, "connect!", 1, 0, 0, (SCM session), "\ Connect to the SSH server.\n\ Return one of the following symbols: 'ok, 'again, 'error\ ") #define FUNC_NAME s_guile_ssh_connect_x { gssh_session_t* data = gssh_session_from_scm (session); int res = ssh_connect (data->ssh_session); _gssh_log_debug_format (FUNC_NAME, session, "result: %d", res); switch (res) { case SSH_OK: return scm_from_locale_symbol ("ok"); case SSH_AGAIN: return scm_from_locale_symbol ("again"); case SSH_ERROR: return scm_from_locale_symbol ("error"); default: /* Must not happen */ assert (0); return SCM_BOOL_F; } } #undef FUNC_NAME SCM_DEFINE (guile_ssh_disconnect, "disconnect!", 1, 0, 0, (SCM arg1), "\ Disconnect from a session (client or server).\n\ Return value is undefined.\ ") #define FUNC_NAME s_guile_ssh_disconnect { gssh_session_t* session_data = gssh_session_from_scm (arg1); _gssh_log_debug (FUNC_NAME, "Disconnecting session ...", arg1); if (ssh_is_connected (session_data->ssh_session)) { _gssh_log_debug (FUNC_NAME, "Closing channels", arg1); gssh_session_close_all_channels_x (session_data); ssh_disconnect (session_data->ssh_session); } _gssh_log_debug (FUNC_NAME, "Disconnecting session ... done", arg1); return SCM_UNDEFINED; } #undef FUNC_NAME SCM_DEFINE (guile_ssh_get_protocol_version, "get-protocol-version", 1, 0, 0, (SCM arg1), "\ Get SSH version.\n\ Return 1 for SSH1, 2 for SSH2 or #f on error.\ ") #define FUNC_NAME s_guile_ssh_get_protocol_version { gssh_session_t* data = gssh_session_from_scm (arg1); SCM ret; int version; GSSH_VALIDATE_CONNECTED_SESSION (data, arg1, SCM_ARG1); version = ssh_get_version (data->ssh_session); if (version >= 0) ret = scm_from_int (version); else ret = SCM_BOOL_F; return ret; } #undef FUNC_NAME SCM_DEFINE (guile_ssh_get_error, "get-error", 1, 0, 1, (SCM arg1), "\ Retrieve the error text message from the last error.\ ") { gssh_session_t* data = gssh_session_from_scm (arg1); SCM error = scm_from_locale_string (ssh_get_error (data->ssh_session)); return error; } /* Authenticate the server. Return one of the following symbols: 'ok, 'known-changed, 'found-other, 'not-known, 'file-not-found, 'error Asserts: - Return value of `ssh_is_server_known' is one of the valid constants described in libssh.h */ SCM_DEFINE (guile_ssh_authenticate_server, "authenticate-server", 1, 0, 0, (SCM session), "\ Authenticate the server.\n\ Return one of the following symbols: 'ok, 'known-changed, 'found-other,\n\ 'not-known, 'file-not-found, 'error\ ") #define FUNC_NAME s_guile_ssh_authenticate_server { gssh_session_t* data = gssh_session_from_scm (session); int res; GSSH_VALIDATE_CONNECTED_SESSION (data, session, SCM_ARG1); #if HAVE_LIBSSH_0_9 res = ssh_session_is_known_server (data->ssh_session); #else res = ssh_is_server_known (data->ssh_session); #endif _gssh_log_debug_format (FUNC_NAME, session, "result: %d", res); switch (res) { case SSH_SERVER_KNOWN_OK: return scm_from_locale_symbol ("ok"); case SSH_SERVER_KNOWN_CHANGED: return scm_from_locale_symbol ("known-changed"); case SSH_SERVER_FOUND_OTHER: return scm_from_locale_symbol ("found-other"); case SSH_SERVER_NOT_KNOWN: return scm_from_locale_symbol ("not-known"); case SSH_SERVER_FILE_NOT_FOUND: return scm_from_locale_symbol ("file-not-found"); case SSH_SERVER_ERROR: return scm_from_locale_symbol ("error"); default: /* Must not happen. */ assert (0); return SCM_BOOL_F; } } #undef FUNC_NAME SCM_DEFINE (guile_ssh_get_server_public_key, "get-server-public-key", 1, 0, 0, (SCM session), "\ Get server public key from a SESSION.\n\ Return server's public key. Throw `guile-ssh-error' on error.\ ") #define FUNC_NAME s_guile_ssh_get_server_public_key { gssh_session_t *sd = gssh_session_from_scm (session); gssh_key_t *kd; int res; SCM key_smob; GSSH_VALIDATE_CONNECTED_SESSION (sd, session, SCM_ARG1); kd = make_gssh_key (); /* TODO: Check `kd' for NULL. */ #if HAVE_LIBSSH_0_8 res = ssh_get_server_publickey (sd->ssh_session, &kd->ssh_key); #else res = ssh_get_publickey (sd->ssh_session, &kd->ssh_key); #endif _gssh_log_debug_format (FUNC_NAME, session, "result: %d", res); if (res != SSH_OK) guile_ssh_error1 (FUNC_NAME, "Unable to get the server key", session); SCM_NEWSMOB (key_smob, key_tag, kd); return key_smob; } #undef FUNC_NAME SCM_DEFINE (guile_ssh_write_known_host, "write-known-host!", 1, 0, 0, (SCM session), "\ Write the current server as known in the known hosts file.\n\ Return value is undefined.\ ") #define FUNC_NAME s_guile_ssh_write_known_host { gssh_session_t *session_data = gssh_session_from_scm (session); int res; GSSH_VALIDATE_CONNECTED_SESSION (session_data, session, SCM_ARG1); #if HAVE_LIBSSH_0_9 res = ssh_session_update_known_hosts (session_data->ssh_session); #else res = ssh_write_knownhost (session_data->ssh_session); #endif _gssh_log_debug_format (FUNC_NAME, session, "result: %d", res); if (res != SSH_OK) guile_ssh_session_error1 (FUNC_NAME, session_data->ssh_session, session); return SCM_UNDEFINED; } #undef FUNC_NAME /* Predicates */ SCM_DEFINE (guile_ssh_is_connected_p, "connected?", 1, 0, 0, (SCM arg1), "\ Check if we are connected.\n\ Return #f if we are connected to a server, #f if we aren't.\ ") #define FUNC_NAME s_guile_ssh_is_connected_p { gssh_session_t* data = gssh_session_from_scm (arg1); int res = ssh_is_connected (data->ssh_session); _gssh_log_debug_format (FUNC_NAME, arg1, "result: %d", res); return scm_from_bool (res); } #undef FUNC_NAME /* Initialize session related functions. */ void init_session_func (void) { #include "session-func.x" } /* session-func.c ends here */ guile-ssh-0.18.0/libguile-ssh/session-func.h000066400000000000000000000026011471416131000206510ustar00rootroot00000000000000/* Copyright (C) 2013 Artyom V. Poptsov * * This file is part of Guile-SSH. * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #ifndef __SESSION_FUNC_H__ #define __SESSION_FUNC_H__ #include extern SCM guile_ssh_make_session (void); extern SCM guile_ssh_is_session_p (SCM arg1); extern SCM guile_ssh_blocking_flush (SCM arg1, SCM arg2); extern SCM guile_ssh_session_set (SCM arg1, SCM arg2, SCM arg3); extern SCM guile_ssh_session_get (SCM arg1, SCM arg2); extern SCM guile_ssh_get_version (SCM arg1); extern SCM guile_ssh_is_connected_p (SCM arg1); extern SCM guile_ssh_connect_x (SCM arg1); extern SCM guile_ssh_disconnect (SCM session); extern SCM guile_ssh_authenticate_server (SCM arg1); extern void init_session_func (void); #endif /* ifndef __SESSION_FUNC_H__ */ guile-ssh-0.18.0/libguile-ssh/session-main.c000066400000000000000000000020021471416131000206300ustar00rootroot00000000000000/* session-main.c -- SSH session initialization. * * Copyright (C) 2013 Artyom V. Poptsov * * This file is part of Guile-SSH. * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #include #include "session-type.h" #include "session-func.h" #include "threads.h" void init_session (void) { init_session_type (); init_session_func (); init_pthreads (); } /* session-main.c ends here */ guile-ssh-0.18.0/libguile-ssh/session-type.c000066400000000000000000000114361471416131000207000ustar00rootroot00000000000000/* session-type.c -- SSH session smob. * * Copyright (C) 2013, 2014, 2015, 2016 Artyom V. Poptsov * * This file is part of Guile-SSH. * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #include #include #include #include #include "session-type.h" #include "channel-type.h" #include "session-func.h" #include "error.h" #include "common.h" static const char* GSSH_SESSION_TYPE_NAME = "session"; scm_t_bits session_tag; /* Smob tag. */ static SCM _mark (SCM session_smob) { if (! gssh_session_freed_p (session_smob)) { gssh_session_t *sd = gssh_session_from_scm (session_smob); scm_gc_mark (sd->channels); return sd->callbacks; } else { return SCM_BOOL_F; } } /* Handle GC'ing of the session smob. */ static size_t _free (SCM session) { if (! gssh_session_freed_p (session)) { gssh_session_t *sd = gssh_session_from_scm (session); guile_ssh_disconnect (session); ssh_free (sd->ssh_session); SCM_SET_SMOB_DATA (session, NULL); } return 0; } static SCM _equalp (SCM x1, SCM x2) { return compare_objects(x1, x2, (converter_t) gssh_session_from_scm); } static int _print (SCM session, SCM port, scm_print_state *pstate) { char *user = NULL; char *host = NULL; unsigned int ssh_port; int res; scm_puts ("#ssh_session, SSH_OPTIONS_USER, &user); scm_display ((res == SSH_OK) ? scm_from_locale_string (user) : SCM_UNDEFINED, port); ssh_string_free_char (user); scm_putc ('@', port); res = ssh_options_get (sd->ssh_session, SSH_OPTIONS_HOST, &host); scm_display ((res == SSH_OK) ? scm_from_locale_string (host) : SCM_UNDEFINED, port); ssh_string_free_char (host); scm_putc (':', port); res = ssh_options_get_port (sd->ssh_session, &ssh_port); scm_display ((res == SSH_OK) ? scm_from_int (ssh_port) : SCM_UNDEFINED, port); scm_puts (ssh_is_connected (sd->ssh_session) ? " (connected) " : " (disconnected) ", port); } else { scm_puts ("(freed) ", port); } scm_display (_scm_object_hex_address (session), port); scm_putc ('>', port); return 1; } /* Internal procedure. Add a CHANNEL to the channel list of a SESSION. */ void gssh_session_add_channel_x (gssh_session_t* session, SCM channel) { session->channels = scm_cons (channel, session->channels); } /* Internal procedure. */ void gssh_session_del_channel_x (gssh_session_t* session, SCM channel) { session->channels = scm_delete (channel, session->channels); } /* Internal procedure. */ void gssh_session_close_all_channels_x (gssh_session_t* session) { int32_t length; while ((length = scm_to_int (scm_length (session->channels))) > 0) { scm_close_port (scm_list_ref (session->channels, scm_from_int (0))); } } /** * Internal procedure. * * Create a Guile-SSH session object. */ gssh_session_t* make_gssh_session () { return (gssh_session_t *) scm_gc_malloc (sizeof (gssh_session_t), GSSH_SESSION_TYPE_NAME); } /* Helper procedures */ SCM gssh_session_to_scm (gssh_session_t* session) { SCM smob; SCM_NEWSMOB (smob, session_tag, session); return smob; } /* Convert SCM object to a SSH session */ gssh_session_t* gssh_session_from_scm (SCM x) #define FUNC_NAME "gssh_session_from_scm" { scm_assert_smob_type (session_tag, x); return (gssh_session_t *) SCM_SMOB_DATA (x); } #undef FUNC_NAME /** * Check if a SESSION is freed. */ int gssh_session_freed_p (SCM session) { return SCM_SMOBNUM (session) == 0; } /* session smob initialization. */ void init_session_type (void) { session_tag = scm_make_smob_type (GSSH_SESSION_TYPE_NAME, sizeof (gssh_session_t)); set_smob_callbacks (session_tag, _mark, _free, _equalp, _print); #include "session-type.x" } /* session.c ends here */ guile-ssh-0.18.0/libguile-ssh/session-type.h000066400000000000000000000035421471416131000207040ustar00rootroot00000000000000/* Copyright (C) 2013 Artyom V. Poptsov * * This file is part of Guile-SSH. * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #ifndef __SESSION_TYPE_H__ #define __SESSION_TYPE_H__ #include #include #include "channel-type.h" extern scm_t_bits session_tag; struct gssh_session { ssh_session ssh_session; SCM callbacks; SCM channels; }; typedef struct gssh_session gssh_session_t; /* Make sure that the session pointed by session data structure pointer SD is connected. */ #define GSSH_VALIDATE_CONNECTED_SESSION(sd, scm, pos) \ do { \ SCM_ASSERT_TYPE (ssh_is_connected (sd->ssh_session), scm, \ pos, FUNC_NAME, "connected session"); \ } while (0) extern void gssh_session_add_channel_x (gssh_session_t* session, SCM channel); extern void gssh_session_del_channel_x (gssh_session_t* session, SCM channel); extern void gssh_session_close_all_channels_x (gssh_session_t* session); extern gssh_session_t* make_gssh_session (); extern void init_session_type (void); /* Helper procedures */ extern SCM gssh_session_to_scm (gssh_session_t* session); extern gssh_session_t* gssh_session_from_scm (SCM x); extern int gssh_session_freed_p (SCM session); #endif /* ifndef __SESSION_TYPE_H__ */ guile-ssh-0.18.0/libguile-ssh/sftp-dir-func.c000066400000000000000000000144531471416131000207210ustar00rootroot00000000000000/* sftp-dir-func.c -- Functions for working with SFTP directories. * * Copyright (C) 2022 Artyom V. Poptsov * * This file is part of Guile-SSH * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #include /* Guile */ #include /* libssh */ #include #include /* Guile-SSH */ #include "common.h" #include "error.h" #include "sftp-session-type.h" #include "sftp-dir-type.h" SCM_GSSH_DEFINE (gssh_sftp_dir_p, "sftp-dir?", 1, (SCM x)) { return scm_from_bool (SCM_SMOB_PREDICATE (sftp_dir_tag, x)); } SCM_GSSH_DEFINE (gssh_sftp_dir_path, "sftp-dir-path", 1, (SCM sftp_dir)) #define FUNC_NAME s_gssh_sftp_dir_path { gssh_sftp_dir_t* dir = gssh_sftp_dir_from_scm (sftp_dir); return dir->path; } #undef FUNC_NAME SCM_GSSH_DEFINE (gssh_sftp_dir_session, "sftp-dir-session", 1, (SCM sftp_dir)) #define FUNC_NAME s_gssh_sftp_dir_path { gssh_sftp_dir_t* dir = gssh_sftp_dir_from_scm (sftp_dir); return dir->gssh_sftp_session; } #undef FUNC_NAME SCM_GSSH_DEFINE (gssh_sftp_dir_open, "sftp-dir-open", 2, (SCM sftp_session, SCM path)) #define FUNC_NAME s_gssh_sftp_dir_open { gssh_sftp_session_t* data = gssh_sftp_session_from_scm (sftp_session); sftp_dir dir; char* c_path; scm_dynwind_begin (0); c_path = scm_to_locale_string (path); scm_dynwind_free (c_path); dir = sftp_opendir (data->sftp_session, c_path); if (dir == NULL) { guile_ssh_error1 (FUNC_NAME, "Could not open a directory", scm_list_2 (sftp_session, path)); } scm_dynwind_end (); return gssh_sftp_dir_to_scm (dir, path, sftp_session); } #undef FUNC_NAME SCM_GSSH_DEFINE (gssh_sftp_dir_close, "sftp-dir-close", 1, (SCM sftp_dir)) #define FUNC_NAME s_gssh_sftp_dir_close { gssh_sftp_dir_t* dir = gssh_sftp_dir_from_scm (sftp_dir); int rc = sftp_closedir (dir->dir); if (rc == SSH_ERROR) { guile_ssh_error1 (FUNC_NAME, "Could not close an SFTP directory", sftp_dir); } return SCM_UNDEFINED; } #undef FUNC_NAME SCM_GSSH_DEFINE (gssh_sftp_dir_eof_p, "sftp-dir-eof?", 1, (SCM sftp_dir)) #define FUNC_NAME s_gssh_sftp_closedir { gssh_sftp_dir_t* dir = gssh_sftp_dir_from_scm (sftp_dir); int rc = sftp_dir_eof (dir->dir); return scm_from_bool (rc); } #undef FUNC_NAME /* This macro constructs an SCM pair from an SFTP attribute symbol and a C integer value. */ #define CONS_INT_ATTR(name, value) \ scm_cons (gssh_sftp_attr_ ## name, scm_from_int (value)) /* This macro constructs an SCM pair from an SFTP atribute symbol and a C string SFTP attribute. */ #define CONS_STR_ATTR(name, value) \ scm_cons (gssh_sftp_attr_ ## name, \ value ? scm_from_locale_string (value) : SCM_BOOL_F) /* This macro constructs an SCM pair from an SFTP attribute symbol and a SSH string value. */ #define CONS_SST_ATTR(name, value) \ scm_cons (gssh_sftp_attr_ ## name, \ value \ ? scm_from_locale_string (ssh_string_to_char (value)) \ : SCM_BOOL_F) static SCM scm_from_sftp_dir_attributes (sftp_attributes attrs) { return scm_list_n (CONS_STR_ATTR (name, attrs->name), CONS_STR_ATTR (longname, attrs->longname), CONS_INT_ATTR (flags, attrs->flags), CONS_INT_ATTR (type, attrs->type), CONS_INT_ATTR (size, attrs->size), CONS_INT_ATTR (uid, attrs->uid), CONS_INT_ATTR (gid, attrs->gid), CONS_STR_ATTR (owner, attrs->owner), CONS_STR_ATTR (group, attrs->group), CONS_INT_ATTR (permissions, attrs->permissions), CONS_INT_ATTR (atime64, attrs->atime64), CONS_INT_ATTR (atime, attrs->atime), CONS_INT_ATTR (atime_nseconds, attrs->atime_nseconds), CONS_INT_ATTR (createtime, attrs->createtime), CONS_INT_ATTR (createtime_nseconds, attrs->createtime_nseconds), CONS_INT_ATTR (mtime64, attrs->mtime64), CONS_INT_ATTR (mtime, attrs->mtime), CONS_INT_ATTR (mtime_nseconds, attrs->mtime_nseconds), CONS_SST_ATTR (acl, attrs->acl), CONS_INT_ATTR (extended_count, attrs->extended_count), CONS_SST_ATTR (extended_type, attrs->extended_type), CONS_SST_ATTR (extended_data, attrs->extended_data), SCM_UNDEFINED); } #undef CONS_INT_ATTR #undef CONS_STR_ATTR #undef CONS_SST_ATTR SCM_GSSH_DEFINE (gssh_sftp_dir_read, "sftp-dir-read", 1, (SCM sftp_dir)) #define FUNC_NAME s_gssh_sftp_dir_read { gssh_sftp_dir_t* dir = gssh_sftp_dir_from_scm (sftp_dir); gssh_sftp_session_t* session = gssh_sftp_session_from_scm (dir->gssh_sftp_session); sftp_attributes attrs = sftp_readdir (session->sftp_session, dir->dir); if (attrs == NULL) { return SCM_BOOL_F; } return scm_from_sftp_dir_attributes (attrs); } #undef FUNC_NAME /* Initialize functions. */ void init_sftp_dir_func (void) { #include "sftp-dir-func.x" } /* Local Variables: c-file-style: "gnu" End: */ /* sftp-dir-func.c ends here. */ guile-ssh-0.18.0/libguile-ssh/sftp-dir-func.h000066400000000000000000000015611471416131000207220ustar00rootroot00000000000000/* Copyright (C) 2022 Artyom V. Poptsov * * This file is part of Guile-SSH. * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #ifndef __SFTP_DIR_FUNC_H__ #define __SFTP_DIR_FUNC_H__ void init_sftp_dir_func (void); #endif /* ifndef __SFTP_DIR_FUNC_H__ */ guile-ssh-0.18.0/libguile-ssh/sftp-dir-main.c000066400000000000000000000020151471416131000207010ustar00rootroot00000000000000/* sftp-dir-main.c -- SFTP dir initialization. * * Copyright (C) 2022 Artyom V. Poptsov * * This file is part of Guile-SSH. * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #include #include "threads.h" #include "sftp-dir-type.h" #include "sftp-dir-func.h" void init_sftp_dir (void) { init_sftp_dir_type (); init_sftp_dir_func (); init_pthreads (); } /* sftp-dir-main.c ends here. */ guile-ssh-0.18.0/libguile-ssh/sftp-dir-type.c000066400000000000000000000103021471416131000207340ustar00rootroot00000000000000/* sftp-dir-type.c -- SFTP dir type. * * Copyright (C) 2022 Artyom V. Poptsov * * This file is part of Guile-SSH. * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #include #include #include #include #include "common.h" #include "error.h" #include "sftp-session-type.h" #include "sftp-dir-type.h" static const char* GSSH_SFTP_DIR_TYPE_NAME = "sftp-dir"; /* Guile-SSH SFTP directory attribute names. */ SCM_GLOBAL_SYMBOL (gssh_sftp_attr_name, "name"); SCM_GLOBAL_SYMBOL (gssh_sftp_attr_longname, "longname"); SCM_GLOBAL_SYMBOL (gssh_sftp_attr_flags, "flags"); SCM_GLOBAL_SYMBOL (gssh_sftp_attr_type, "type"); SCM_GLOBAL_SYMBOL (gssh_sftp_attr_size, "size"); SCM_GLOBAL_SYMBOL (gssh_sftp_attr_uid, "uid"); SCM_GLOBAL_SYMBOL (gssh_sftp_attr_gid, "gid"); SCM_GLOBAL_SYMBOL (gssh_sftp_attr_owner, "owner"); SCM_GLOBAL_SYMBOL (gssh_sftp_attr_group, "group"); SCM_GLOBAL_SYMBOL (gssh_sftp_attr_permissions, "permissions"); SCM_GLOBAL_SYMBOL (gssh_sftp_attr_atime64, "atime64"); SCM_GLOBAL_SYMBOL (gssh_sftp_attr_atime, "atime"); SCM_GLOBAL_SYMBOL (gssh_sftp_attr_atime_nseconds, "atime-nseconds"); SCM_GLOBAL_SYMBOL (gssh_sftp_attr_createtime, "createtime"); SCM_GLOBAL_SYMBOL (gssh_sftp_attr_createtime_nseconds, "createtime-nseconds"); SCM_GLOBAL_SYMBOL (gssh_sftp_attr_mtime64, "mtime64"); SCM_GLOBAL_SYMBOL (gssh_sftp_attr_mtime, "mtime"); SCM_GLOBAL_SYMBOL (gssh_sftp_attr_mtime_nseconds, "mtime-nseconds"); SCM_GLOBAL_SYMBOL (gssh_sftp_attr_acl, "acl"); SCM_GLOBAL_SYMBOL (gssh_sftp_attr_extended_count, "extended-count"); SCM_GLOBAL_SYMBOL (gssh_sftp_attr_extended_type, "extended-type"); SCM_GLOBAL_SYMBOL (gssh_sftp_attr_extended_data, "extended-data"); scm_t_bits sftp_dir_tag; /* Smob tag. */ gssh_sftp_dir_t* make_gssh_sftp_dir () { return (gssh_sftp_dir_t *) scm_gc_malloc (sizeof (gssh_sftp_dir_t), GSSH_SFTP_DIR_TYPE_NAME); } SCM gssh_sftp_dir_to_scm (sftp_dir dir, SCM path, SCM sftp_session) { gssh_sftp_dir_t* data = make_gssh_sftp_dir (); SCM smob; data->gssh_sftp_session = sftp_session; data->dir = dir; data->path = path; SCM_NEWSMOB (smob, sftp_dir_tag, data); return smob; } gssh_sftp_dir_t * gssh_sftp_dir_from_scm (SCM x) { scm_assert_smob_type (sftp_dir_tag, x); return (gssh_sftp_dir_t *) SCM_SMOB_DATA (x); } static SCM _mark (SCM sftp_dir) { gssh_sftp_dir_t* data = gssh_sftp_dir_from_scm (sftp_dir); scm_gc_mark (data->path); return data->gssh_sftp_session; } static size_t _free (SCM sftp_dir) { gssh_sftp_dir_t* data = gssh_sftp_dir_from_scm (sftp_dir); int rc = sftp_closedir (data->dir); assert (rc == SSH_NO_ERROR); return 0; } static SCM _equalp (SCM x1, SCM x2) { return compare_objects(x1, x2, (converter_t) gssh_sftp_dir_from_scm); } static int _print (SCM sftp_dir, SCM port, scm_print_state* pstate) { scm_puts ("#', port); return 1; } /* SMOB Initialization. */ void init_sftp_dir_type (void) { sftp_dir_tag = scm_make_smob_type (GSSH_SFTP_DIR_TYPE_NAME, sizeof (gssh_sftp_dir_t)); set_smob_callbacks (sftp_dir_tag, _mark, _free, _equalp, _print); #include "sftp-dir-type.x" } /* sftp-dir-type.c ends here. */ guile-ssh-0.18.0/libguile-ssh/sftp-dir-type.h000066400000000000000000000043601471416131000207500ustar00rootroot00000000000000/* sftp-dir-type.h -- SFTP dir type description. */ /* Copyright (C) 2022 Artyom V. Poptsov * * This file is part of Guile-SSH. * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #ifndef __SFTP_DIR_TYPE_H__ #define __SFTP_DIR_TYPE_H__ #include #include /* Smob data. */ struct gssh_sftp_dir { /* Reference to the parent SFTP session. */ SCM gssh_sftp_session; /* Path to the directory on the remote host. */ SCM path; /* libssh directory (opaque object.) */ sftp_dir dir; }; typedef struct gssh_sftp_dir gssh_sftp_dir_t; extern scm_t_bits sftp_dir_tag; extern SCM gssh_sftp_attr_name; extern SCM gssh_sftp_attr_longname; extern SCM gssh_sftp_attr_flags; extern SCM gssh_sftp_attr_type; extern SCM gssh_sftp_attr_size; extern SCM gssh_sftp_attr_uid; extern SCM gssh_sftp_attr_gid; extern SCM gssh_sftp_attr_owner; extern SCM gssh_sftp_attr_group; extern SCM gssh_sftp_attr_permissions; extern SCM gssh_sftp_attr_atime64; extern SCM gssh_sftp_attr_atime; extern SCM gssh_sftp_attr_atime_nseconds; extern SCM gssh_sftp_attr_createtime; extern SCM gssh_sftp_attr_createtime_nseconds; extern SCM gssh_sftp_attr_mtime64; extern SCM gssh_sftp_attr_mtime; extern SCM gssh_sftp_attr_mtime_nseconds; extern SCM gssh_sftp_attr_acl; extern SCM gssh_sftp_attr_extended_count; extern SCM gssh_sftp_attr_extended_type; extern SCM gssh_sftp_attr_extended_data; void init_sftp_dir_type (void); gssh_sftp_dir_t* make_gssh_sftp_dir (); SCM gssh_sftp_dir_to_scm (sftp_dir dir, SCM path, SCM sftp_session); gssh_sftp_dir_t* gssh_sftp_dir_from_scm (SCM x); #endif /* ifndef __SFTP_DIR_TYPE_H__ */ /* sftp-dir-type.h ends here. */ guile-ssh-0.18.0/libguile-ssh/sftp-file-main.c000066400000000000000000000017311471416131000210460ustar00rootroot00000000000000/* sftp-file-main.c -- SFTP file initialization. * * Copyright (C) 2015 Artyom V. Poptsov * * This file is part of Guile-SSH. * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #include #include "threads.h" #include "sftp-file-type.h" void init_sftp_file (void) { init_sftp_file_type (); init_pthreads (); } /* sftp-file-main.c ends here. */ guile-ssh-0.18.0/libguile-ssh/sftp-file-type.c000066400000000000000000000247571471416131000211200ustar00rootroot00000000000000/* sftp-file-type.c -- SFTP file type. * * Copyright (C) 2015, 2016 Artyom V. Poptsov * Copyright (C) 2017 Ludovic Courtès * * This file is part of Guile-SSH. * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #include #include #include #include "common.h" #include "error.h" #include "sftp-session-type.h" #include "sftp-file-type.h" static const char* GSSH_SFTP_FILE_TYPE_NAME = "sftp-file"; gssh_port_t sftp_file_tag; /* Smob tag. */ enum { DEFAULT_PORT_R_BUFSZ = 256, /* Default read buffer size */ DEFAULT_PORT_W_BUFSZ = 1 /* Default write buffer size */ }; /* Ptob callbacks. */ #if USING_GUILE_BEFORE_2_2 /* Read data from the channel. Return EOF if no data is available or throw `guile-ssh-error' if an error occurred. */ static int ptob_fill_input (SCM file) #define FUNC_NAME "ptob_fill_input" { gssh_sftp_file_t *fd = gssh_sftp_file_from_scm (file); scm_port *pt = SCM_PTAB_ENTRY (file); ssize_t res; res = sftp_read (fd->file, pt->read_buf, pt->read_buf_size); if (! res) return EOF; else if (res < 0) guile_ssh_error1 (FUNC_NAME, "Error reading the file", file); pt->read_pos = pt->read_buf; pt->read_end = pt->read_buf + res; return *pt->read_buf; } #undef FUNC_NAME static void ptob_write (SCM file, const void* data, size_t sz) #define FUNC_NAME "ptob_write" { gssh_sftp_file_t *fd = gssh_sftp_file_from_scm (file); ssize_t nwritten = sftp_write (fd->file, data, sz); if (nwritten != sz) guile_ssh_error1 (FUNC_NAME, "Error writing the file", file); } #undef FUNC_NAME #else /* !USING_GUILE_BEFORE_2_2 */ static size_t read_from_sftp_file_port (SCM file, SCM dst, size_t start, size_t count) #define FUNC_NAME "read_from_sftp_file_port" { char *data = (char *) SCM_BYTEVECTOR_CONTENTS (dst) + start; gssh_sftp_file_t *fd = gssh_sftp_file_from_scm (file); ssize_t res; res = sftp_read (fd->file, data, count); if (res < 0) guile_ssh_error1 (FUNC_NAME, "Error reading the file", file); return res; } #undef FUNC_NAME static size_t write_to_sftp_file_port (SCM file, SCM src, size_t start, size_t count) #define FUNC_NAME "write_to_sftp_file_port" { char *data = (char *) SCM_BYTEVECTOR_CONTENTS (src) + start; gssh_sftp_file_t *fd = gssh_sftp_file_from_scm (file); ssize_t nwritten = sftp_write (fd->file, data, count); if (nwritten < 0) guile_ssh_error1 (FUNC_NAME, "Error reading the file", file); return nwritten; } #undef FUNC_NAME #endif /* !USING_GUILE_BEFORE_2_2 */ static int ptob_input_waiting (SCM file) #define FUNC_NAME "ptob_input_waiting" { gssh_sftp_file_t *fd = gssh_sftp_file_from_scm (file); sftp_attributes attr = sftp_fstat (fd->file); uint64_t pos = sftp_tell64 (fd->file); return attr->size - pos; } #undef FUNC_NAME #if USING_GUILE_BEFORE_2_2 static SCM equalp_sftp_file (SCM x1, SCM x2) { return compare_objects(x1, x2, (converter_t) gssh_sftp_file_from_scm); } #endif static int print_sftp_file (SCM sftp_file, SCM port, scm_print_state *pstate) { gssh_sftp_file_t *fd = gssh_sftp_file_from_scm (sftp_file); ssh_session session = fd->file->sftp->session; char *user = NULL; char *host = NULL; unsigned int ssh_port; int res; scm_puts ("#", port); return 1; } #if USING_GUILE_BEFORE_2_2 /* Complete the processing of buffered output data. Currently this callback makes no effect because a SFTP_FILE uses unbuffered output. */ static void ptob_flush (SCM sftp_file) #define FUNC_NAME "ptob_flush" { scm_port *pt = SCM_PTAB_ENTRY (sftp_file); size_t wrsize = pt->write_pos - pt->write_buf; if (wrsize) ptob_write (sftp_file, pt->write_buf, wrsize); pt->write_pos = pt->write_buf; } #undef FUNC_NAME #endif #if USING_GUILE_BEFORE_2_2 static int #else static void #endif ptob_close (SCM sftp_file) { gssh_sftp_file_t *fd = gssh_sftp_file_from_scm (sftp_file); #if USING_GUILE_BEFORE_2_2 scm_port *pt = SCM_PTAB_ENTRY (sftp_file); ptob_flush (sftp_file); #endif if (fd) { sftp_close (fd->file); } SCM_SETSTREAM (sftp_file, NULL); #if USING_GUILE_BEFORE_2_2 scm_gc_free (pt->write_buf, pt->write_buf_size, "port write buffer"); scm_gc_free (pt->read_buf, pt->read_buf_size, "port read buffer"); return 1; #endif } static scm_t_off ptob_seek (SCM port, scm_t_off offset, int whence) #define FUNC_NAME "ptob_seek" { gssh_sftp_file_t *fd = gssh_sftp_file_from_scm (port); scm_t_off target; /* In Guile 2.2, PORT is flushed before this function is called; in 2.0 that wasn't the case. */ #if USING_GUILE_BEFORE_2_2 { scm_t_port *pt = SCM_PTAB_ENTRY (port); if (pt->rw_active == SCM_PORT_WRITE) ptob_flush (port); if (pt->rw_active == SCM_PORT_READ) scm_end_input (port); } #endif switch (whence) { case SEEK_CUR: { uint64_t current_pos = sftp_tell64 (fd->file); target = current_pos + offset; } break; case SEEK_END: { sftp_attributes attr = sftp_fstat (fd->file); if (! attr) { guile_ssh_error1 (FUNC_NAME, "Could not get file attributes", port); } target = attr->size - offset; } break; default: /* SEEK_SET */ target = offset; break; } if (target < 0) scm_misc_error (FUNC_NAME, "negative offset", SCM_EOL); if (sftp_seek64 (fd->file, target)) guile_ssh_error1 (FUNC_NAME, "Could not seek a file", port); return target; } #undef FUNC_NAME /* Public Scheme procedures */ SCM_GSSH_DEFINE (gssh_sftp_open, "%gssh-sftp-open", 4, (SCM sftp_session, SCM path, SCM access_type, SCM mode)) #define FUNC_NAME s_gssh_sftp_open { gssh_sftp_session_t *sftp_sd = gssh_sftp_session_from_scm (sftp_session); sftp_file file; char* c_path; int c_access_type; mode_t c_mode; SCM_ASSERT (scm_is_string (path), path, SCM_ARG2, FUNC_NAME); SCM_ASSERT (scm_is_number (access_type), access_type, SCM_ARG3, FUNC_NAME); SCM_ASSERT (scm_is_number (mode), mode, SCM_ARG4, FUNC_NAME); scm_dynwind_begin (0); c_path = scm_to_locale_string (path); scm_dynwind_free (c_path); c_access_type = scm_to_uint (access_type); c_mode = scm_to_uint (mode); file = sftp_open (sftp_sd->sftp_session, c_path, c_access_type, c_mode); if (file == NULL) { guile_ssh_error1 (FUNC_NAME, "Could not open a file", scm_list_4 (sftp_session, path, access_type, mode)); } scm_dynwind_end (); return make_gssh_sftp_file (file, path, sftp_session); } #undef FUNC_NAME SCM_GSSH_DEFINE (gssh_sftp_file_p, "%gssh-sftp-file?", 1, (SCM x)) { #if USING_GUILE_BEFORE_2_2 return scm_from_bool (SCM_SMOB_PREDICATE (sftp_file_tag, x)); #else return scm_from_bool (SCM_PORTP (x) && SCM_PORT_TYPE (x) == sftp_file_tag); #endif } /* Public C procedures */ /* Convert SCM object X to a SFTP file data object. */ gssh_sftp_file_t * gssh_sftp_file_from_scm (SCM x) { #if USING_GUILE_BEFORE_2_2 scm_assert_smob_type (sftp_file_tag, x); #else SCM_ASSERT_TYPE (SCM_PORTP (x) && SCM_PORT_TYPE (x) == sftp_file_tag, x, 1, __func__, "sftp-file-port"); #endif return (gssh_sftp_file_t *) SCM_STREAM (x); } /* Convert SFTP file FD to a SCM object; set SFTP_SESSION as a parent of the object. */ SCM make_gssh_sftp_file (const sftp_file file, const SCM name, SCM sftp_session) { SCM ptob; gssh_sftp_file_t *fd = scm_gc_malloc (sizeof (gssh_sftp_file_t), GSSH_SFTP_FILE_TYPE_NAME); fd->sftp_session = sftp_session; fd->file = file; #if USING_GUILE_BEFORE_2_2 { scm_port *pt; ptob = scm_new_port_table_entry (sftp_file_tag); pt = SCM_PTAB_ENTRY (ptob); /* Output init */ pt->write_buf_size = DEFAULT_PORT_R_BUFSZ; pt->write_buf = scm_gc_malloc (pt->write_buf_size, "port write buffer"); pt->write_pos = pt->write_end = pt->write_buf; /* Input init */ pt->read_buf_size = DEFAULT_PORT_W_BUFSZ; pt->read_buf = scm_gc_malloc (pt->read_buf_size, "port read buffer"); pt->read_pos = pt->read_end = pt->read_buf; pt->rw_random = 1; SCM_SET_CELL_TYPE (ptob, sftp_file_tag | SCM_RDNG | SCM_WRTNG | SCM_OPN); SCM_SETSTREAM (ptob, fd); } #else ptob = scm_c_make_port (sftp_file_tag, SCM_RDNG | SCM_WRTNG | SCM_OPN, (scm_t_bits) fd); #endif scm_set_port_filename_x (ptob, name); return ptob; } /* Ptob initialization. */ void init_sftp_file_type (void) { sftp_file_tag = scm_make_port_type ((char*) GSSH_SFTP_FILE_TYPE_NAME, #if USING_GUILE_BEFORE_2_2 &ptob_fill_input, &ptob_write #else read_from_sftp_file_port, write_to_sftp_file_port #endif ); #if USING_GUILE_BEFORE_2_2 scm_set_port_flush (sftp_file_tag, ptob_flush); scm_set_port_equalp (sftp_file_tag, equalp_sftp_file); #endif scm_set_port_close (sftp_file_tag, ptob_close); scm_set_port_input_waiting (sftp_file_tag, ptob_input_waiting); scm_set_port_print (sftp_file_tag, print_sftp_file); scm_set_port_seek (sftp_file_tag, ptob_seek); #include "sftp-file-type.x" } /* sftp-file-type.c ends here. */ guile-ssh-0.18.0/libguile-ssh/sftp-file-type.h000066400000000000000000000030501471416131000211040ustar00rootroot00000000000000/* sftp-file-type.h -- SFTP file type description. */ /* Copyright (C) 2015 Artyom V. Poptsov * * This file is part of Guile-SSH. * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #ifndef __SFTP_FILE_TYPE_H__ #define __SFTP_FILE_TYPE_H__ #include #include /* Smob data. */ struct gssh_sftp_file { /* Reference to the parent SFTP session. */ SCM sftp_session; sftp_file file; }; typedef struct gssh_sftp_file gssh_sftp_file_t; extern SCM gssh_sftp_open (SCM sftp_session, SCM path, SCM access_type, SCM mode); extern SCM gssh_sftp_file_p (SCM x); extern void init_sftp_file_type (void); extern gssh_sftp_file_t* gssh_sftp_file_from_scm (SCM x); extern SCM make_gssh_sftp_file (const sftp_file file, const SCM name, SCM sftp_session); #endif /* ifndef __SFTP_FILE_TYPE_H__ */ /* sftp-file-type.h ends here. */ guile-ssh-0.18.0/libguile-ssh/sftp-session-func.c000066400000000000000000000203021471416131000216140ustar00rootroot00000000000000/* sftp-session-func.c -- Functions for working with SFTP sessions. * * Copyright (C) 2015-2021 Artyom V. Poptsov * * This file is part of Guile-SSH * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #include /* Guile */ #include /* libssh */ #include #include /* Guile-SSH */ #include "common.h" #include "error.h" #include "sftp-session-type.h" SCM_GSSH_DEFINE (gssh_sftp_init, "%gssh-sftp-init", 1, (SCM sftp_session)) #define FUNC_NAME s_gssh_sftp_init { gssh_sftp_session_t *sftp_sd = gssh_sftp_session_from_scm (sftp_session); if (sftp_init (sftp_sd->sftp_session)) { guile_ssh_error1 (FUNC_NAME, "Could not initialize the SFTP session.", sftp_session); } return SCM_UNDEFINED; } #undef FUNC_NAME SCM_GSSH_DEFINE (gssh_sftp_get_session, "%gssh-sftp-get-session", 1, (SCM sftp_session)) { gssh_sftp_session_t *sftp_sd = gssh_sftp_session_from_scm (sftp_session); return sftp_sd->session; } SCM_GSSH_DEFINE (gssh_sftp_mkdir, "%gssh-sftp-mkdir", 3, (SCM sftp_session, SCM dirname, SCM mode)) #define FUNC_NAME s_gssh_sftp_mkdir { gssh_sftp_session_t *sftp_sd = gssh_sftp_session_from_scm (sftp_session); char *c_dirname; SCM_ASSERT (scm_is_string (dirname), dirname, SCM_ARG2, FUNC_NAME); SCM_ASSERT (scm_is_number (mode), mode, SCM_ARG3, FUNC_NAME); scm_dynwind_begin (0); c_dirname = scm_to_locale_string (dirname); scm_dynwind_free (c_dirname); if (sftp_mkdir (sftp_sd->sftp_session, c_dirname, scm_to_uint32 (mode))) { guile_ssh_error1 (FUNC_NAME, "Could not create a directory", scm_list_3 (sftp_session, dirname, mode)); } scm_dynwind_end (); return SCM_UNDEFINED; } #undef FUNC_NAME SCM_GSSH_DEFINE (gssh_sftp_rmdir, "%gssh-sftp-rmdir", 2, (SCM sftp_session, SCM dirname)) #define FUNC_NAME s_gssh_sftp_rmdir { gssh_sftp_session_t *sftp_sd = gssh_sftp_session_from_scm (sftp_session); char *c_dirname; SCM_ASSERT (scm_is_string (dirname), dirname, SCM_ARG2, FUNC_NAME); scm_dynwind_begin (0); c_dirname = scm_to_locale_string (dirname); scm_dynwind_free (c_dirname); if (sftp_rmdir (sftp_sd->sftp_session, c_dirname)) { guile_ssh_error1 (FUNC_NAME, "Could not remove a directory", scm_list_2 (sftp_session, dirname)); } scm_dynwind_end (); return SCM_UNDEFINED; } #undef FUNC_NAME SCM_GSSH_DEFINE (gssh_sftp_mv, "%gssh-sftp-mv", 3, (SCM sftp_session, SCM source, SCM dest)) #define FUNC_NAME s_gssh_sftp_mv { gssh_sftp_session_t *sftp_sd = gssh_sftp_session_from_scm (sftp_session); char *c_source; char *c_dest; SCM_ASSERT (scm_is_string (source), source, SCM_ARG2, FUNC_NAME); SCM_ASSERT (scm_is_string (dest), dest, SCM_ARG3, FUNC_NAME); scm_dynwind_begin (0); c_source = scm_to_locale_string (source); scm_dynwind_free (c_source); c_dest = scm_to_locale_string (dest); scm_dynwind_free (c_dest); if (sftp_rename (sftp_sd->sftp_session, c_source, c_dest)) { guile_ssh_error1 (FUNC_NAME, "Could not move a file", scm_list_3 (sftp_session, source, dest)); } scm_dynwind_end (); return SCM_UNDEFINED; } #undef FUNC_NAME SCM_GSSH_DEFINE (gssh_sftp_chmod, "%gssh-sftp-chmod", 3, (SCM sftp_session, SCM filename, SCM mode)) #define FUNC_NAME s_gssh_sftp_chmod { gssh_sftp_session_t *sftp_sd = gssh_sftp_session_from_scm (sftp_session); char *c_filename; SCM_ASSERT (scm_is_string (filename), filename, SCM_ARG2, FUNC_NAME); SCM_ASSERT (scm_is_number (mode), mode, SCM_ARG3, FUNC_NAME); scm_dynwind_begin (0); c_filename = scm_to_locale_string (filename); scm_dynwind_free (c_filename); if (sftp_chmod (sftp_sd->sftp_session, c_filename, scm_to_uint32 (mode))) { guile_ssh_error1 (FUNC_NAME, "Could not chmod a file", scm_list_3 (sftp_session, filename, mode)); } scm_dynwind_end (); return SCM_UNDEFINED; } #undef FUNC_NAME SCM_GSSH_DEFINE (gssh_sftp_symlink, "%gssh-sftp-symlink", 3, (SCM sftp_session, SCM target, SCM dest)) #define FUNC_NAME s_gssh_sftp_symlink { gssh_sftp_session_t *sftp_sd = gssh_sftp_session_from_scm (sftp_session); char *c_target; char *c_dest; SCM_ASSERT (scm_is_string (target), target, SCM_ARG2, FUNC_NAME); SCM_ASSERT (scm_is_string (dest), dest, SCM_ARG3, FUNC_NAME); scm_dynwind_begin (0); c_target = scm_to_locale_string (target); scm_dynwind_free (c_target); c_dest = scm_to_locale_string (dest); scm_dynwind_free (c_dest); if (sftp_symlink (sftp_sd->sftp_session, c_target, c_dest)) { guile_ssh_error1 (FUNC_NAME, "Could not create a symlink", scm_list_3 (sftp_session, target, dest)); } scm_dynwind_end (); return SCM_UNDEFINED; } #undef FUNC_NAME SCM_GSSH_DEFINE (gssh_sftp_readlink, "%gssh-sftp-readlink", 2, (SCM sftp_session, SCM path)) #define FUNC_NAME s_gssh_sftp_readlink { gssh_sftp_session_t *sftp_sd = gssh_sftp_session_from_scm (sftp_session); char *c_path; char *ret; SCM_ASSERT (scm_is_string (path), path, SCM_ARG2, FUNC_NAME); scm_dynwind_begin (0); c_path = scm_to_locale_string (path); scm_dynwind_free (c_path); ret = sftp_readlink (sftp_sd->sftp_session, c_path); scm_dynwind_end (); return ret ? scm_take_locale_string (ret) : SCM_BOOL_F; } #undef FUNC_NAME SCM_GSSH_DEFINE (gssh_sftp_unlink, "%gssh-sftp-unlink", 2, (SCM sftp_session, SCM path)) #define FUNC_NAME s_gssh_sftp_unlink { gssh_sftp_session_t *sftp_sd = gssh_sftp_session_from_scm (sftp_session); char *c_path; int ret; SCM_ASSERT (scm_is_string (path), path, SCM_ARG2, FUNC_NAME); scm_dynwind_begin (0); c_path = scm_to_locale_string (path); scm_dynwind_free (c_path); ret = sftp_unlink (sftp_sd->sftp_session, c_path); if (ret) { guile_ssh_error1 (FUNC_NAME, "Could not unlink a file", scm_list_2 (sftp_session, path)); } scm_dynwind_end (); return SCM_UNDEFINED; } #undef FUNC_NAME /* Possible SFTP return codes. */ static gssh_symbol_t sftp_return_codes[] = { { "fx-ok", SSH_FX_OK }, { "fx-eof", SSH_FX_EOF }, { "fx-no-such-file", SSH_FX_NO_SUCH_FILE }, { "fx-permission-denied", SSH_FX_PERMISSION_DENIED }, { "fx-failure", SSH_FX_FAILURE }, { "fx-bad-message", SSH_FX_BAD_MESSAGE }, { "fx-no-connection", SSH_FX_NO_CONNECTION }, { "fx-connection-lost", SSH_FX_CONNECTION_LOST }, { "fx-op-unsupported", SSH_FX_OP_UNSUPPORTED }, { "fx-invalid-handle", SSH_FX_INVALID_HANDLE }, { "fx-no-such-path", SSH_FX_NO_SUCH_PATH }, { "fx-file-already-exist", SSH_FX_FILE_ALREADY_EXISTS }, { "fx-write-protect", SSH_FX_WRITE_PROTECT }, { "fx-no-media", SSH_FX_NO_MEDIA }, { NULL, -1 } }; SCM_GSSH_DEFINE (gssh_sftp_get_error, "%gssh-sftp-get-error", 1, (SCM sftp_session)) #define FUNC_NAME s_gssh_sftp_get_error { gssh_sftp_session_t *sftp_sd = gssh_sftp_session_from_scm (sftp_session); int rc = sftp_get_error (sftp_sd->sftp_session); if (rc < 0) { guile_ssh_error1 (FUNC_NAME, "Could not get an error code", sftp_session); } return gssh_symbol_to_scm (sftp_return_codes, rc); } #undef FUNC_NAME void init_sftp_session_func (void) { #include "sftp-session-func.x" } /* sftp-session-func.c ends here. */ guile-ssh-0.18.0/libguile-ssh/sftp-session-func.h000066400000000000000000000030041471416131000216210ustar00rootroot00000000000000/* Copyright (C) 2015-2021 Artyom V. Poptsov * * This file is part of Guile-SSH. * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #ifndef __SFTP_SESSION_FUNC_H__ #define __SFTP_SESSION_FUNC_H__ #include extern SCM gssh_sftp_init (SCM sftp_session); extern SCM gssh_sftp_get_session (SCM sftp_session); extern SCM gssh_sftp_mkdir (SCM sftp_session, SCM dirname, SCM mode); extern SCM gssh_sftp_rmdir (SCM sftp_session, SCM dirname); extern SCM gssh_sftp_mv (SCM sftp_session, SCM source, SCM dest); extern SCM gssh_sftp_chmod (SCM sftp_session, SCM filename, SCM mode); extern SCM gssh_sftp_symlink (SCM sftp_session, SCM target, SCM dest); extern SCM gssh_sftp_readlink (SCM sftp_session, SCM path); extern SCM gssh_sftp_unlink (SCM sftp_session, SCM path); extern SCM gssh_sftp_get_error (SCM sftp_session); extern void init_sftp_session_func (void); #endif /* ifndef __SFTP_SESSION_FUNC_H__ */ guile-ssh-0.18.0/libguile-ssh/sftp-session-main.c000066400000000000000000000020471471416131000216130ustar00rootroot00000000000000/* sftp-session-main.c -- SFTP session initialization. * * Copyright (C) 2015 Artyom V. Poptsov * * This file is part of Guile-SSH. * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #include #include "threads.h" #include "sftp-session-type.h" #include "sftp-session-func.h" void init_sftp_session (void) { init_sftp_session_type (); init_sftp_session_func (); init_pthreads (); } /* sftp-session-main.c ends here. */ guile-ssh-0.18.0/libguile-ssh/sftp-session-type.c000066400000000000000000000061761471416131000216570ustar00rootroot00000000000000/* sftp-session-type.c -- SFTP session smob. * * Copyright (C) 2015-2021 Artyom V. Poptsov * * This file is part of Guile-SSH * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #include #include #include #include #include "common.h" #include "error.h" #include "session-type.h" #include "sftp-session-type.h" scm_t_bits sftp_session_tag; /* Smob tag. */ /* GC callbacks. */ static SCM _mark (SCM sftp_session) { gssh_sftp_session_t *sftp_sd = gssh_sftp_session_from_scm (sftp_session); return sftp_sd->session; } static size_t _free (SCM sftp_session) { gssh_sftp_session_t *sftp_sd = (gssh_sftp_session_t *) SCM_SMOB_DATA (sftp_session); sftp_free (sftp_sd->sftp_session); return 0; } static SCM _equalp (SCM x1, SCM x2) { return compare_objects(x1, x2, (converter_t) gssh_sftp_session_from_scm); } /* Printing procedure. */ static int _print (SCM sftp_session, SCM port, scm_print_state *pstate) { scm_puts ("#", port); return 1; } SCM_GSSH_DEFINE (gssh_sftp_session_p, "%gssh-sftp-session?", 1, (SCM x)) { return scm_from_bool (SCM_SMOB_PREDICATE (sftp_session_tag, x)); } SCM_GSSH_DEFINE (gssh_make_sftp_session, "%gssh-make-sftp-session", 1, (SCM session)) #define FUNC_NAME s_gssh_make_sftp_session { gssh_session_t *sd = gssh_session_from_scm (session); sftp_session sftp_session = sftp_new (sd->ssh_session); if (! sftp_session) guile_ssh_error1 (FUNC_NAME, "Could not create a SFTP session", session); return make_gssh_sftp_session (sftp_session, session); } #undef FUNC_NAME gssh_sftp_session_t * gssh_sftp_session_from_scm (SCM x) { scm_assert_smob_type (sftp_session_tag, x); return (gssh_sftp_session_t *) SCM_SMOB_DATA (x); } SCM make_gssh_sftp_session (sftp_session sftp_session, SCM session) { SCM smob; gssh_sftp_session_t *sftp_sd = (gssh_sftp_session_t *) scm_gc_malloc (sizeof (gssh_sftp_session_t), "sftp session"); sftp_sd->sftp_session = sftp_session; sftp_sd->session = session; SCM_NEWSMOB (smob, sftp_session_tag, sftp_sd); return smob; } void init_sftp_session_type (void) { sftp_session_tag = scm_make_smob_type ("sftp session", sizeof (gssh_sftp_session_t)); set_smob_callbacks (sftp_session_tag, _mark, _free, _equalp, _print); #include "sftp-session-type.x" } /* sftp-type.c ends here. */ guile-ssh-0.18.0/libguile-ssh/sftp-session-type.h000066400000000000000000000031071471416131000216530ustar00rootroot00000000000000/* Copyright (C) 2015-2021 Artyom V. Poptsov * * This file is part of Guile-SSH. * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #ifndef __SFTP_SESSION_TYPE_H__ #define __SFTP_SESSION_TYPE_H__ #include #include #include extern scm_t_bits sftp_session_tag; /* Smob data. */ struct gssh_sftp_session { /* Reference to the parent session. We need to keep the reference to prevent the session from premature freeing by the GC. */ SCM session; sftp_session sftp_session; }; typedef struct gssh_sftp_session gssh_sftp_session_t; extern SCM gssh_sftp_session_p (SCM arg1); extern SCM gssh_make_sftp_session (SCM arg1); extern void init_sftp_session_type (void); /* Internal procedures */ extern gssh_sftp_session_t* gssh_sftp_session_from_scm (SCM x); extern SCM make_gssh_sftp_session (sftp_session sftp_session, SCM session); #endif /* ifndef __SFTP_SESSION_TYPE_H__ */ /* sftp-session-type.h ends here. */ guile-ssh-0.18.0/libguile-ssh/threads.c000066400000000000000000000034111471416131000176620ustar00rootroot00000000000000/* threads.c -- Initialization of SSH threads * * Copyright (C) 2013, 2020 Artyom V. Poptsov * * This file is part of Guile-SSH. * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #include #include #include "threads.h" /* Since version 0.8.0, when libssh is dynamically linked, it is not necessary to call 'ssh_init'/'ssh_finalize' on systems which are fully supported with regards to threading (that is, system with pthreads available). See for details. */ #if ! HAVE_LIBSSH_0_8 /* Current SSH threading state */ static int pthreads_state = SSH_PTHREADS_DISABLED; /* This procedure is called when the Guile-SSH library is unloaded. */ __attribute__((__destructor__)) void cleanup () { ssh_finalize (); } /* Initialize threading if it has not been initialized yet. */ void init_pthreads (void) { if (pthreads_state == SSH_PTHREADS_DISABLED) { ssh_threads_set_callbacks (ssh_threads_get_pthread ()); ssh_init (); pthreads_state = SSH_PTHREADS_ENABLED; } } #endif /* if ! HAVE_LIBSSH_0_8 */ /* threads.c ends here */ guile-ssh-0.18.0/libguile-ssh/threads.h000066400000000000000000000017651471416131000177010ustar00rootroot00000000000000/* Copyright (C) 2013 Artyom V. Poptsov * * This file is part of Guile-SSH. * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #ifndef __THREADS_H__ #define __THREADS_H__ #if ! HAVE_LIBSSH_0_8 #define SSH_PTHREADS_DISABLED 0 #define SSH_PTHREADS_ENABLED 1 void init_pthreads (void); #else #define init_pthreads() #endif /* if ! HAVE_LIBSSH_0_8 */ #endif /* ifndef __THREADS_H__ */ guile-ssh-0.18.0/libguile-ssh/version.c000066400000000000000000000032341471416131000177200ustar00rootroot00000000000000/* version.c -- Get information about versions. * * Copyright (C) 2013-2022 Artyom V. Poptsov * * This file is part of Guile-SSH. * * Guile-SSH 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 3 of the * License, or (at your option) any later version. * * Guile-SSH 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 Guile-SSH. If not, see . */ #include #include #include #include "config.h" /* Get version of the libssh. */ SCM_DEFINE (guile_ssh_get_libssh_version, "%get-libssh-version", 0, 0, 0, (), "\ Get version of the libssh.\ ") { const char *version = ssh_version (0); return scm_from_locale_string (version); } /* Get version of the Guile-SSH. */ SCM_DEFINE (guile_ssh_get_library_version, "get-library-version", 0, 0, 0, (), "Get version of the Guile-SSH.") { return scm_from_locale_string (PACKAGE_VERSION); } SCM_DEFINE (gssh_dsa_supported_p, "dsa-support?", 0, 0, 0, (), "\ Check if DSA keys are enabled.\ ") #define FUNC_NAME s_gssh_dsa_supported_p { return scm_from_bool (ENABLE_DSA); } #undef FUNC_NAME void init_version (void) { #include "version.x" } /* version.c ends here */ guile-ssh-0.18.0/modules/000077500000000000000000000000001471416131000151465ustar00rootroot00000000000000guile-ssh-0.18.0/modules/Makefile.am000066400000000000000000000014231471416131000172020ustar00rootroot00000000000000## Copyright (C) 2015 Artyom V. Poptsov ## ## This file is part of Guile-SSH. ## ## Guile-SSH 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 3 of the ## License, or (at your option) any later version. ## ## Guile-SSH 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 Guile-SSH. If not, see . SUBDIRS = ssh ## Makefile.am ends here. guile-ssh-0.18.0/modules/ssh/000077500000000000000000000000001471416131000157435ustar00rootroot00000000000000guile-ssh-0.18.0/modules/ssh/Makefile.am000066400000000000000000000023411471416131000177770ustar00rootroot00000000000000## Copyright (C) 2013-2021 Artyom V. Poptsov ## ## This file is part of Guile-SSH. ## ## Guile-SSH 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 3 of the ## License, or (at your option) any later version. ## ## Guile-SSH 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 Guile-SSH. If not, see . include $(top_srcdir)/build-aux/am/guile.am SUBDIRS = dist SOURCES = \ auth.scm channel.scm key.scm session.scm \ server.scm message.scm version.scm log.scm \ tunnel.scm dist.scm sftp.scm popen.scm \ shell.scm agent.scm ETAGS_ARGS = auth.scm channel.scm key.scm session.scm server.scm \ message.scm version.scm popen.scm agent.scm moddir=$(prefix)/share/guile/site/$(GUILE_EFFECTIVE_VERSION)/ssh godir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache/ssh ## Makefile.am ends here. guile-ssh-0.18.0/modules/ssh/agent.scm000066400000000000000000000112061471416131000175450ustar00rootroot00000000000000;;; agent.scm -- Interaction with SSH agents. ;; Copyright (C) 2020-2021 Artyom V. Poptsov ;; ;; This file is a part of Guile-SSH. ;; ;; Guile-SSH 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 3 of the ;; License, or (at your option) any later version. ;; ;; Guile-SSH 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 Guile-SSH. If not, see ;; . ;;; Commentary: ;; The module contains procedures for interaction with SSH agent instances. ;; ;; The module provides the following procedures: ;; ssh-agent-sock-get ;; ssh-agent-sock-set! ;; ssh-agent-start ;; ssh-agent-stop ;; ssh-agent-info ;; ;; See the Info documentation for detailed description of these exceptions and ;; aforementioned procedures. ;;; Code: (define-module (ssh agent) #:use-module (ice-9 regex) #:use-module (ice-9 rdelim) #:use-module (ice-9 popen) #:export (ssh-agent-sock-get ssh-agent-sock-set! ssh-agent-start ssh-agent-stop ssh-agent-info)) (define %ssh-agent-sock-env "SSH_AUTH_SOCK") (define %ssh-agent-dir-regexp (make-regexp "^ssh-[A-Za-z0-9]{12}")) (define %ssh-agent-pid-file-regexp (make-regexp "agent.[0-9]+")) (define %ssh-auth-sock-regexp (make-regexp "SSH_AUTH_SOCK=(.*); export SSH_AUTH_SOCK;")) (define %ssh-agent-pid-regexp (make-regexp "SSH_AGENT_PID=(.*); export SSH_AGENT_PID;")) (define (ssh-agent-start) "Start an OpenSSH agent. Return a list with SSH agent information." (let ((p (open-input-pipe "ssh-agent -s"))) (let ((ssh-auth-sock-data (read-line p)) (ssh-agent-pid-data (read-line p))) (when (or (eof-object? ssh-auth-sock-data) (eof-object? ssh-agent-pid-data)) (error "Could not start a SSH agent")) (close p) (let ((sockm (regexp-exec %ssh-auth-sock-regexp ssh-auth-sock-data)) (pidm (regexp-exec %ssh-agent-pid-regexp ssh-agent-pid-data))) (unless (and sockm pidm) (error "Could not parse SSH agent response" ssh-auth-sock-data ssh-agent-pid-data)) `((SSH_AUTH_SOCK . ,(match:substring sockm 1)) (SSH_AGENT_PID . ,(match:substring pidm 1))))))) (define (ssh-agent-stop) "Kill the current agent (given by the 'SSH_AGENT_PID' environment variable)." (system "ssh-agent -k")) (define* (ssh-agent-info #:key (user (getenv "USER")) (path (or (getenv "TMPDIR") "/tmp"))) "Get OpenSSH agent information for a given USER as a list." (define (owned-by-user? file-name uid) (= (stat:uid (stat file-name)) uid)) (define (user->uid user) (passwd:uid (getpwnam user))) (define (get-agent-socket-file dir-name) (let ((stream (opendir dir-name))) (let loop ((file-name (readdir stream))) (if (regexp-exec %ssh-agent-pid-file-regexp file-name) (begin (closedir stream) file-name) (loop (readdir stream)))))) (define (agent-socket->pid agent-socket) (cadr (string-split agent-socket #\.))) (let ((dir (opendir path)) (uid (user->uid user))) (let loop ((entry (readdir dir)) (info '())) (if (eof-object? entry) (begin (closedir dir) info) (let ((file-name (string-append path "/" entry))) (if (and (regexp-exec %ssh-agent-dir-regexp entry) (owned-by-user? file-name uid)) (let* ((agent-socket (get-agent-socket-file file-name)) (auth-sock (string-append file-name "/" agent-socket)) (agent-pid (agent-socket->pid agent-socket))) (loop (readdir dir) (append info (list (list (cons 'SSH_AUTH_SOCK auth-sock) (cons 'SSH_AGENT_PID agent-pid)))))) (loop (readdir dir) info))))))) (define (ssh-agent-sock-get) "Get the 'SSH_AGENT_SOCK' environment variable value." (getenv %ssh-agent-sock-env)) (define (ssh-agent-sock-set! sock-file) "Set the value of 'SSH_AGENT_SOCK' environment variable." (setenv %ssh-agent-sock-env sock-file)) ;;; agent.scm ends here. guile-ssh-0.18.0/modules/ssh/auth.scm000066400000000000000000000032241471416131000174110ustar00rootroot00000000000000;;; auth.scm -- API for SSH user authentication. ;; Copyright (C) 2013-2021 Artyom V. Poptsov ;; ;; This file is a part of Guile-SSH. ;; ;; Guile-SSH 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 3 of the ;; License, or (at your option) any later version. ;; ;; Guile-SSH 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 Guile-SSH. If not, see . ;;; Commentary: ;; This module contains API that is used for SSH user authentication. ;; ;; These methods are exported: ;; ;; userauth-public-key! ;; userauth-public-key/auto! ;; userauth-public-key/try ;; userauth-agent! ;; userauth-password! ;; userauth-gssapi! ;; userauth-none! ;; userauth-get-list ;;; Code: (define-module (ssh auth) #:use-module (ice-9 popen) #:use-module (ice-9 rdelim) #:use-module (ice-9 regex) #:use-module (ssh log) #:use-module (ssh session) #:export (userauth-public-key! userauth-public-key/auto! userauth-public-key/try userauth-agent! userauth-password! userauth-gssapi! userauth-none! userauth-get-list)) (unless (getenv "GUILE_SSH_CROSS_COMPILING") (load-extension "libguile-ssh" "init_auth_func")) ;;; auth.scm ends here. guile-ssh-0.18.0/modules/ssh/channel.scm000066400000000000000000000107251471416131000200640ustar00rootroot00000000000000;;; channel.scm -- API for SSH channel manipulation. ;; Copyright (C) 2013, 2014, 2015, 2016 Artyom V. Poptsov ;; ;; This file is a part of Guile-SSH. ;; ;; Guile-SSH 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 3 of the ;; License, or (at your option) any later version. ;; ;; Guile-SSH 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 Guile-SSH. If not, see ;; . ;;; Commentary: ;; This module contains API that is used for working with SSH ;; channels. ;; ;; These procedures are exported: ;; ;; channel? ;; make-channel ;; channel-open-session ;; channel-request-env ;; channel-request-exec ;; channel-request-pty ;; channel-request-shell ;; channel-open-forward ;; channel-cancel-forward ;; channel-set-pty-size! ;; channel-set-stream! ;; channel-get-stream ;; channel-open? ;; channel-send-eof ;; channel-eof? ;;; Code: (define-module (ssh channel) #:use-module (ssh log) #:use-module (ssh session) #:export (channel channel? make-channel channel-open-session channel-request-env channel-request-exec channel-request-pty channel-request-shell channel-open-forward channel-listen-forward channel-accept-forward channel-cancel-forward channel-request-send-exit-status channel-set-pty-size! channel-set-stream! channel-get-stream channel-get-session channel-get-exit-status channel-open? channel-send-eof channel-eof?)) (define* (make-channel session #:optional (mode OPEN_BOTH)) (cond ((string-contains mode OPEN_BOTH) (%make-channel session (logior RDNG WRTNG))) ((string-contains mode OPEN_READ) (%make-channel session RDNG)) ((string-contains mode OPEN_WRITE) (%make-channel session WRTNG)) (else (throw 'guile-ssh-error "Wrong mode" mode)))) (define* (channel-open-forward channel #:key (source-host "localhost") local-port remote-host (remote-port local-port)) "Open a TCP/IP forwarding channel. Connect to a REMOTE-HOST and REMOTE-PORT, and use SOURCE-HOST and LOCAL-PORT as origination of connections. If the SOURCE-HOST is not set, then \"localhost\" is used. If REMOTE-PORT is not set, then it will be set to LOCAL-PORT value. Please note that the procedure does not bind the LOCAL-PORT and does not automatically forward the content of a socket to the channel." (%channel-open-forward channel remote-host remote-port source-host local-port)) (define* (channel-listen-forward session #:key (address #f) (port 0)) "Send the \"tcpip-forward\" global request using SESSION to ask the server to begin listening for inbound connections on the specified ADDRESS and PORT. If ADDRESS is not specified (or set to #f) then the server binds all addresses on all protocol families supported by the server. When 0 is passed as a PORT then server allocates the next unprivileged port. The procedure returns two values: the first value is the result of the operation (either 'ok', 'again' or 'error'), and the second value is the bound port number (if PORT was set to 0)." (%channel-listen-forward session address port)) (define* (channel-accept-forward session #:optional (timeout 0)) "Accept an incoming TCP/IP forwarding channel and get information about incoming connection. Return two values: the first value is the incoming channel, and the second value is a port number on which the connection was issued." (%channel-accept-forward session timeout)) (define (channel-send-eof channel) "Send an end of file (EOF) on the CHANNEL. This action doesn't close the channel; you may still read from it but not write. Throw 'guile-ssh-error' on an error. Return value is undefined." (%channel-send-eof channel)) ;;; (unless (getenv "GUILE_SSH_CROSS_COMPILING") (load-extension "libguile-ssh" "init_channel")) ;;; channel.scm ends here. guile-ssh-0.18.0/modules/ssh/dist.scm000066400000000000000000000104401471416131000174110ustar00rootroot00000000000000;;; dist.scm -- Spirit of disrtibuted computing for Scheme. ;; Copyright (C) 2014, 2015, 2016, 2017 Artyom V. Poptsov ;; ;; This file is a part of Guile-SSH. ;; ;; Guile-SSH 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 3 of the ;; License, or (at your option) any later version. ;; ;; Guile-SSH 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 Guile-SSH. If not, see ;; . ;;; Commentary: ;; This module contains distributed forms of some useful procedures such as ;; 'map'. ;; ;; The module exports: ;; distribute ;; dist-map ;; with-ssh ;; rrepl ;; make-node ;; node? ;; node-session ;; node-rrepl-port ;; ;; See the Info documentation for the detailed description of these ;; procedures. ;;; Code: (define-module (ssh dist) #:use-module (ice-9 rdelim) #:use-module (ice-9 receive) #:use-module (ice-9 threads) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (ssh session) #:use-module (ssh channel) #:use-module (ssh dist node) #:use-module (ssh dist job) #:use-module (ssh log) #:re-export (node? node-session node-rrepl-port make-node with-ssh) #:export (distribute dist-map rrepl)) ;;; Helper procedures (define (flatten-1 lst) "Flatten a list LST one level down. Return a flattened list." (fold-right append '() lst)) (define (format-warning fmt . args) (apply format (current-error-port) (string-append "WARNING: " fmt) args)) (define (format-error fmt . args) (apply format (current-error-port) (string-append "ERROR: " fmt) args)) (define (execute-job nodes job) "Execute a JOB, handle errors." (catch 'node-error (lambda () (catch 'node-repl-error (lambda () (hand-out-job job)) (lambda args (format-error "In ~a:~%~a:~%~a~%" job (cadr args) (caddr args)) (error "Could not execute a job" job)))) (lambda args (format-warning "Could not execute a job ~a~%" job) (let ((nodes (delete (job-node job) nodes))) (when (null? nodes) (error "Could not execute a job" job)) (format-warning "Passing a job ~a to a node ~a ...~%" job (car nodes)) (execute-job nodes (set-job-node job (car nodes))))))) (define (execute-jobs nodes jobs) "Execute JOBS on NODES, return the result." (format-log 'functions "execute-jobs" "nodes: ~a; jobs: ~a" nodes jobs) (flatten-1 (n-par-map (length jobs) (cut execute-job nodes <>) jobs))) ;;; (define-syntax-rule (distribute nodes expr ...) "Evaluate each EXPR in parallel, using distributed computation. Split the job to nearly equal parts and hand out each of resulting sub-jobs to a NODES list. Return the results of N expressions as a set of N multiple values." (let* ((jobs (assign-eval nodes (list (quote expr) ...))) (results (execute-jobs nodes jobs))) (when (null? results) (error "Could not execute jobs" nodes jobs)) (apply values results))) (define-syntax-rule (dist-map nodes proc lst) "Do list mapping using distributed computation. The job is split into nearly equal parts and hand out resulting jobs to a NODES list. Return the result of computation." (let* ((jobs (assign-map nodes lst (quote proc))) (results (execute-jobs nodes jobs))) (format-log 'functions "dist-map" "jobs: ~a; results: ~a" jobs results) (when (null? results) (error "Could not execute jobs" nodes jobs)) results)) (define (rrepl node) "Start an interactive remote REPL (RREPL) session using NODE." (let ((repl-channel (node-open-rrepl node))) (while (channel-open? repl-channel) (cond ((and (channel-open? repl-channel) (char-ready? repl-channel)) (display (read-char repl-channel))) ((and (channel-open? repl-channel) (char-ready? (current-input-port))) (display (read-char (current-input-port)) repl-channel)) (else (usleep 5000)))))) ;;; dist.scm ends here guile-ssh-0.18.0/modules/ssh/dist/000077500000000000000000000000001471416131000167065ustar00rootroot00000000000000guile-ssh-0.18.0/modules/ssh/dist/Makefile.am000066400000000000000000000017441471416131000207500ustar00rootroot00000000000000## Copyright (C) 2015-2021 Artyom V. Poptsov ## ## This file is part of Guile-SSH. ## ## Guile-SSH 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 3 of the ## License, or (at your option) any later version. ## ## Guile-SSH 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 Guile-SSH. If not, see . include $(top_srcdir)/build-aux/am/guile.am SOURCES = \ node.scm \ job.scm moddir=$(prefix)/share/guile/site/$(GUILE_EFFECTIVE_VERSION)/ssh/dist godir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache/ssh/dist ## Makefile.am ends here guile-ssh-0.18.0/modules/ssh/dist/job.scm000066400000000000000000000114361471416131000201710ustar00rootroot00000000000000;;; job.scm -- Distributed jobs. ;; Copyright (C) 2015-2020 Artyom V. Poptsov ;; ;; This file is a part of Guile-SSH. ;; ;; Guile-SSH 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 3 of the ;; License, or (at your option) any later version. ;; ;; Guile-SSH 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 Guile-SSH. If not, see ;; . ;;; Commentary: ;; This module describes a job object that holds information on a distributed ;; computing job. This information includes the job type, the node that is ;; assigned for execution of the job (see (ssh dist node)), job data and ;; procedure(s) to process the data. ;; ;; The module exports the following procedures: ;; make-job ;; job? ;; job-type ;; job-node ;; set-job-node ;; job-data ;; job-proc ;; assign-eval ;; assign-map ;; hand-out-job ;; job->sexp ;; split ;; ;; See the Info documentation for detailed description of these procedures. ;;; Code: (define-module (ssh dist job) #:use-module (ice-9 receive) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-module (srfi srfi-9 gnu) #:use-module (srfi srfi-26) #:use-module (ssh dist node) #:use-module (ssh log) #:export (make-job job? job-type job-node set-job-node job-data job-proc assign-eval assign-map hand-out-job ;; Helper procedures job->sexp split)) (define-record-type (make-job type node data proc) job? (type job-type) (node job-node) (data job-data) (proc job-proc)) (define (set-job-node job node) "A functional setter that returns a new copy of JOB with the node field changed to a NODE." (make-job (job-type job) node (job-data job) (job-proc job))) (set-record-type-printer! (lambda (job port) (format port "#" (job-type job) (job-node job) (number->string (object-address job) 16)))) (define (job->sexp job) "Convert a JOB to an equivalent symbolic expression." (case (job-type job) ((map) `(map ,(job-proc job) ',(job-data job))) ((eval) `(map primitive-eval ',(job-proc job))) (else (error "Unknown job type" job)))) (define (split lst count) "Split a list LST into COUNT chunks. Return a list of chunks." (define (append-list lst . items) "Append ITEMS list to LST." (append lst items)) (define (list-rest lst lst-len k) "Skip the first K elements of LST, return the list with the rest of the LST elements. If K is lesser than LST-LEN then return all the elements of LST." (if (< k lst-len) (list-tail lst k) lst)) (receive (chunk-size-q chunk-size-r) (round/ (length lst) count) (let loop ((l lst) (n count) (res '())) (let ((l-len (length l))) (if (> n 0) (if (> l-len 1) (loop (list-rest l l-len chunk-size-q) (1- n) (append-list res (if (> n 1) (list-head l chunk-size-q) l))) (append-list res l)) res))))) (define (assign-eval nodes expressions) "Split an EXPRESSIONS list to nearly equal parts according to the length of a NODES list and assign each evaluation job to a node. Return a list of assigned jobs." (map (cut make-job 'eval <> #f <>) nodes (split expressions (length nodes)))) (define (assign-map nodes lst proc) "Split the 'map' work to nearly equal parts according to the length of NODES list and assign each part of work to a node. Return a list of assigned jobs." (map (cut make-job 'map <> <> proc) nodes (split lst (length nodes)))) (define (hand-out-job job) "Hand out JOB to the assigned node and return the result of computation." (format-log 'functions "hand-out-job" "node: ~a; type: ~a; proc: ~a; data: ~a" (job-node job) (job-type job) (job-proc job) (job-data job)) (case (job-type job) ((map) (node-eval-1 (job-node job) `(,(job-type job) ,(job-proc job) (quote ,(job-data job))))) ((eval) (map (lambda (expr) (node-eval-1 (job-node job) expr)) (job-proc job))) (else (error "Unknown job type" job)))) ;;; job.scm ends here. guile-ssh-0.18.0/modules/ssh/dist/node.scm000066400000000000000000000267741471416131000203570ustar00rootroot00000000000000;;; node.scm -- Distributed computing node ;; Copyright (C) 2015, 2016, 2017, 2018, 2019, 2020 Artyom V. Poptsov ;; ;; This file is a part of Guile-SSH. ;; ;; Guile-SSH 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 3 of the ;; License, or (at your option) any later version. ;; ;; Guile-SSH 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 Guile-SSH. If not, see ;; . ;;; Commentary: ;; This module describes the distributed node object. This object holds an ;; SSH tunnel to a remote host and remote REPL port, thus it can be used to ;; execute jobs (see (ssh dist job)). ;; ;; The module provides the following procedures: ;; node? ;; node-session ;; node-rrepl-port ;; make-node ;; node-eval ;; node-open-rrepl ;; node-guile-version ;; node-loadavg ;; with-ssh ;; ;; rrepl-eval ;; rrepl-skip-to-prompt ;; rrepl-get-result ;; ;; There are two specific exceptions that the module procedures can throw: ;; node-error ;; node-repl-error ;; ;; See the Info documentation for detailed description of these exceptions and ;; aforementioned procedures. ;;; Code: (define-module (ssh dist node) #:use-module (ice-9 rdelim) #:use-module (ice-9 regex) #:use-module (ice-9 receive) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-module (srfi srfi-9 gnu) #:use-module (ssh session) #:use-module (ssh session) #:use-module (ssh channel) #:use-module (ssh popen) #:use-module (ssh tunnel) #:use-module (ssh log) #:use-module (ssh shell) #:export (node? node-session node-rrepl-port make-node node-eval node-eval-1 node-guile-version node-loadavg with-ssh rrepl-eval rrepl-skip-to-prompt rrepl-get-result)) (define (eof-or-null? str) "Return #t if a STR is an EOF object or an empty string, #f otherwise." (or (eof-object? str) (string-null? str))) ;;; Error reporting (define (node-error . args) "Raise a node error." (apply throw (cons 'node-error args))) (define (node-repl-error . args) "Raise a REPL error." (apply throw (cons 'node-repl-error args))) ;;; Node type (define-record-type (%make-node session rrepl-port guile-version) node? (session node-session) ; (rrepl-port node-rrepl-port node-rrepl-port-set!) ; (guile-version node-guile-version node-guile-version-set!)) ; (set-record-type-printer! (lambda (node port) (let ((s (node-session node))) (format port "#" (session-get s 'user) (session-get s 'host) (session-get s 'port) (node-guile-version node) (if (port-closed? (node-rrepl-port node)) "stopped" "running") (number->string (object-address node) 16))))) ;;; Helper procedures. (define (rrepl-skip-to-prompt repl-channel) "Read from REPL-CHANNEL until REPL is observed. Throw 'node-error' on an error." (let loop ((line (read-line repl-channel))) (when (eof-object? line) (node-error "Could not locate RREPL prompt" repl-channel)) (unless (string=? "Enter `,help' for help." line) (loop (read-line repl-channel))))) (define (session-open-rrepl session) "Open a stateless RREPL. Return a new RREPL channel." (open-remote-pipe* session OPEN_BOTH "guile" "-q")) (define (make-rrepl session) (let ((rrepl-port (session-open-rrepl session))) (let ((guile-version (read-line rrepl-port))) (when (eof-object? guile-version) (node-repl-error "Could not locate GNU Guile on the node." session)) (rrepl-skip-to-prompt rrepl-port) (values rrepl-port guile-version)))) ;;; (define* (make-node session) "Make a new distributed computing node." (receive (rrepl-port guile-version) (make-rrepl session) (%make-node session rrepl-port guile-version))) ;;; Remote REPL (RREPL) (define (read-string str) "Read a string STR." (call-with-input-string str read)) ;; Regexp for parsing a result of evaluation of an expression that returns a ;; value. (define %repl-result-regexp (make-regexp "^(.*)@(.*)> \\$([0-9]+) = (.*)")) ;; Regexp for parsing a result of evaluation of an expression that returns ;; multiple values. (define %repl-result-2-regexp (make-regexp "^\\$([0-9]+) = (.*)")) ;; Regexp for parsing a result of evaluation of an expression which return ;; value is unspecified. (define %repl-undefined-result-regexp (make-regexp "^(.*)@(.*)> ")) ;; Regexp for parsing an evaluation error. (define %repl-error-regexp (make-regexp "^(.*)@(.*)> ERROR: .*")) (define %repl-error-regexp-2 (make-regexp "^ERROR: .*")) ;; Regexp for parsing "unbound variable" errors. (define %repl-error-unbound-variable (make-regexp "socket:[0-9]+:[0-9]+: \ In procedure module-lookup: Unbound variable: .*")) (define (rrepl-get-result repl-channel) "Get result of evaluation form REPL-CHANNEL, return four values: an evaluation result, a number of the evaluation, a module name and a language name. Throw 'node-repl-error' on an error." (define (raise-repl-error result . rest) "Raise an REPL error with a RESULT of evaluation." (node-repl-error "Evaluation failed" result rest)) (define (parse-result matches lines) (if (null? lines) (reverse matches) (let ((line (car lines))) (if (or (eof-or-null? line) (regexp-exec %repl-undefined-result-regexp line)) (reverse matches) (parse-result (cons (regexp-exec %repl-result-2-regexp line) matches) (cdr lines)))))) (define (read-result match rest) (let* ((matches (parse-result (list match) rest)) (len (length matches))) (catch #t (lambda () (if (= len 1) (let ((m (car matches))) (values (read-string (match:substring m 4)) (string->number (match:substring m 3)))) (let ((rv (make-vector len)) (nv (make-vector len))) ;; The 1st match also contains a module name and language name, ;; but we want only the evaluation result and the result number. (let ((m (car matches))) (vector-set! rv 0 (read-string (match:substring m 4))) (vector-set! nv 0 (string->number (match:substring m 3)))) (do ((i 1 (1+ i))) ((= i len)) (let ((m (list-ref matches i))) (vector-set! rv i (read-string (match:substring m 2))) (vector-set! nv i (string->number (match:substring m 1))))) (values rv nv)))) (lambda (key . message) (case key ((read-error) (raise-repl-error (format #f "Reader error: ~a: ~a: ~a" (car message) (apply format #f (cadr message) (cddr message)) (string-join (map (lambda (match) (match:substring match 0)) matches))))) (else (raise-repl-error message (map (lambda (match) (match:substring match 0)) matches)))))))) (define (error? line) "Does a LINE contain an REPL error message?" (or (regexp-exec %repl-error-regexp line) (regexp-exec %repl-error-regexp-2 line) (regexp-exec %repl-error-unbound-variable line))) (define (error-message? result) "Does a RESULT of evaluation contains a REPL error message?" (find error? result)) (define (handle-response result) (cond ((error-message? result) (raise-repl-error (string-join result "\n"))) ((regexp-exec %repl-result-regexp (car result)) => (lambda (match) (receive (result eval-num) (read-result match (cdr result)) (values result ; Result eval-num ; # of evaluation (match:substring match 2) ; Module (match:substring match 1))))) ; Language ((regexp-exec %repl-undefined-result-regexp (car result)) => (lambda (match) (values *unspecified* ; Result *unspecified* ; # of evaluation (match:substring match 2) ; Module (match:substring match 1)))) ; Language (else (raise-repl-error (string-join result "\n"))))) (define (read-response result) (let ((line (read-line repl-channel))) (if (eof-or-null? line) (handle-response (reverse result)) (read-response (cons line result))))) (read-response '())) (define (rrepl-eval rrepl-channel quoted-exp) "Evaluate QUOTED-EXP using RREPL-CHANNEL, return four values: an evaluation result, a number of the evaluation, a module name and a language name. Throw 'node-repl-error' on an error." (write quoted-exp rrepl-channel) (newline rrepl-channel) (write-line '(newline) rrepl-channel) (rrepl-get-result rrepl-channel)) ;;; Evaluation procedures. (define (node-eval node quoted-exp) "Evaluate QUOTED-EXP on the node and return the evaluated result." (rrepl-eval (node-rrepl-port node) quoted-exp)) (define (node-eval-1 node quoted-exp) "Evaluate QUOTED-EXP on the node and return the evaluated result. The procedure returns the 1st evaluated value if multiple values were returned." (receive (result eval-num module-name language-name) (node-eval node quoted-exp) (if (vector? eval-num) (vector-ref result 0) result))) ;;; Useful macros and procedures. (define-syntax-rule (with-ssh node exp ...) "Evaluate expressions on a remote REPL using a NODE, return four values: an evaluation result, a number of the evaluation, a module name and a language name. Throw 'node-error' or 'node-repl-error' on an error." (node-eval node (quote (begin exp ...)))) (define (node-loadavg node) "Get average load of a NODE. Return an alist of five elements as described in proc(5) man page." (with-ssh node (use-modules (ice-9 rdelim)) (define (list-element->number l n) (string->number (list-ref l n))) (let* ((p (open-input-file "/proc/loadavg")) (raw (read-line p))) (close p) (let ((raw-list (string-split raw #\space))) `((one . ,(list-element->number raw-list 0)) (five . ,(list-element->number raw-list 1)) (fifteen . ,(list-element->number raw-list 2)) (scheduling-entities . ,(map string->number (string-split (list-ref raw-list 3) #\/))) (last-pid . ,(list-element->number raw-list 4))))))) ;;; node.scm ends here guile-ssh-0.18.0/modules/ssh/key.scm000066400000000000000000000043651471416131000172470ustar00rootroot00000000000000;;; key.scm -- SSH keys management. ;; Copyright (C) 2013-2023 Artyom V. Poptsov ;; ;; This file is a part of Guile-SSH. ;; ;; Guile-SSH 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 3 of the ;; License, or (at your option) any later version. ;; ;; Guile-SSH 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 Guile-SSH. If not, see . ;;; Commentary: ;; This module contains API that is used for SSH key management. ;; ;; These methods are exported: ;; ;; key? ;; public-key? ;; private-key? ;; make-keypair ;; get-key-type ;; public-key->string ;; string->pubilc-key ;; public-key-from-file ;; private-key->public-key ;; private-key-from-file ;; private-key-to-file ;; get-public-key-hash ;; bytevector->hex-string ;;; Code: (define-module (ssh key) #:use-module (ice-9 format) #:use-module (rnrs bytevectors) #:use-module (ssh log) #:export (key key? public-key? private-key? make-keypair get-key-type public-key->string string->public-key public-key-from-file private-key->public-key private-key-from-file private-key-to-file get-public-key-hash bytevector->hex-string)) (define (bytevector->hex-string bv) "Convert bytevector BV to a colon separated hex string." (string-join (map (lambda (e) (format #f "~2,'0x" e)) (bytevector->u8-list bv)) ":")) (define* (private-key-from-file path #:key (auth-callback #f) (user-data #f)) (%private-key-from-file path auth-callback user-data)) (unless (getenv "GUILE_SSH_CROSS_COMPILING") (load-extension "libguile-ssh" "init_key")) ;;; key.scm ends here. guile-ssh-0.18.0/modules/ssh/log.scm000066400000000000000000000044451471416131000172370ustar00rootroot00000000000000;;; log.scm -- Guile-SSH logging procedures ;; Copyright (C) 2014 Artyom V. Poptsov ;; ;; This file is a part of Guile-SSH. ;; ;; Guile-SSH 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 3 of the ;; License, or (at your option) any later version. ;; ;; Guile-SSH 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 Guile-SSH. If not, see . ;;; Commentary: ;; This module provides access to libssh logging facilities. These methods ;; are exported: ;; ;; %default-log-printer ;; %default-libssh-log-printer ;; current-logging-callback ;; set-logging-callback! ;; set-log-userdata! ;; get-log-userdata ;; set-log-verbosity! ;; get-log-verbosity ;; format-log ;;; Code: (define-module (ssh log) #:export (%default-log-printer %default-libssh-log-printer current-logging-callback set-logging-callback! set-log-userdata! get-log-userdata set-log-verbosity! get-log-verbosity format-log)) (define (%default-log-printer priority function message userdata) "Default REPL-orented log printer for use with interactive Guile sessions which comments out log messages with \";;; \"" (display ";;; " (current-error-port)) (%default-libssh-log-printer priority function message userdata)) (define (format-log priority procedure-name format-string . args) "Write a formatted message to the libssh log with the given PRIORITY. Priority is expected to be one of the following symbols: 'nolog, 'rare, 'protocol, 'packet, 'functions Return value is undefined." (let ((message (apply format #f format-string args))) (%write-log priority procedure-name message))) (unless (getenv "GUILE_SSH_CROSS_COMPILING") (load-extension "libguile-ssh" "init_log_func") ;; Set the default log printer. (set-logging-callback! %default-log-printer)) ;;; log.scm ends here guile-ssh-0.18.0/modules/ssh/message.scm000066400000000000000000000116051471416131000200760ustar00rootroot00000000000000;;; message.scm -- Procedures for working with SSH messages. ;; Copyright (C) 2013, 2014, 2015 Artyom V. Poptsov ;; ;; This file is a part of Guile-SSH. ;; ;; Guile-SSH 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 3 of the ;; License, or (at your option) any later version. ;; ;; Guile-SSH 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 Guile-SSH. If not, see . ;;; Commentary: ;; This module contains message parsing utilites for Guile-SSH ;; servers. ;; ;; Messages can be fetched from the client by calling ;; `server-message-get' procedure. The server can get content of the ;; requests by calling `message-get-req' procedure with a message ;; passed as an arguement. ;; ;; `message-get-req' returns the content of a request as a vector ;; which can be parsed by related procedures such as `auth:req:user' ;; and friends. ;;; Code: (define-module (ssh message) #:use-module (ssh log) #:use-module (ssh key) #:export (message message? message-reply-default message-reply-success message-get-type message-get-req message-get-session message-service-reply-success service-req:service channel-open-req:orig channel-open-req:orig-port channel-open-req:dest channel-open-req:dest-port message-auth-reply-success message-auth-reply-public-key-ok message-auth-set-methods! auth-req:user auth-req:password auth-req:pubkey auth-req:pubkey-state message-channel-request-reply-success message-channel-request-open-reply-accept message-global-request-reply-success pty-req:term pty-req:width pty-req:height pty-req:pxwidth pty-req:pxheight exec-req:cmd env-req:name env-req:value global-req:addr global-req:port subsystem-req:subsystem)) (define (service-req:service req) (vector-ref req 0)) (define (channel-open-req:orig req) (vector-ref req 0)) (define (channel-open-req:orig-port req) (vector-ref req 1)) (define (channel-open-req:dest req) (vector-ref req 2)) (define (channel-open-req:dest-port req) (vector-ref req 3)) (define (auth-req:user req) (vector-ref req 0)) (define (auth-req:password req) (vector-ref req 1)) (define (auth-req:pubkey req) (vector-ref req 2)) (define (auth-req:pubkey-state req) (vector-ref req 3)) (define (pty-req:term req) (vector-ref req 0)) (define (pty-req:width req) (vector-ref req 1)) (define (pty-req:height req) (vector-ref req 2)) (define (pty-req:pxwidth req) (vector-ref req 3)) (define (pty-req:pxheight req) (vector-ref req 4)) (define (env-req:name req) (vector-ref req 0)) (define (env-req:value req) (vector-ref req 1)) (define (exec-req:cmd req) (vector-ref req 0)) (define (global-req:addr req) (vector-ref req 0)) (define (global-req:port req) (vector-ref req 1)) (define (subsystem-req:subsystem req) (vector-ref req 0)) (define (message-reply-success msg . args) "Reply 'success' to the message MSG. This procedure is a convenient wrapper for other '*-reply-success' procedures. The right procedure to use will be selected depending on a type of the message MSG." (let ((msg-type (message-get-type msg))) (case (car msg-type) ((request-auth) (cond ((= (length args) 0) (message-auth-reply-success msg #f)) ((= (length args) 1) (if (and (symbol? (car args)) (eq? (car args) 'partial)) (message-auth-reply-success msg #t) (error (string-append "message-reply-success: " "Wrong argument. Expected: 'partial") (car args)))) (else (error "message-reply-success: Wrong number of arguments." args)))) ((request-service) (message-service-reply-success msg)) ((request-channel-open) (message-channel-request-reply-success msg)) ((request-channel) (message-channel-request-reply-success msg)) ((request-global) (cond ((= (length args) 1) (message-global-request-reply-success msg (car args))) (else (error "message-reply-success: Wrong number of arguments." args)))) (else (error "Unknown message type" msg-type))))) (unless (getenv "GUILE_SSH_CROSS_COMPILING") (load-extension "libguile-ssh" "init_message")) ;;; message.scm ends here guile-ssh-0.18.0/modules/ssh/popen.scm000066400000000000000000000115061471416131000175730ustar00rootroot00000000000000;;; popen.scm -- Remote popen emulation. ;; Copyright (C) 2015-2024 Artyom V. Poptsov ;; ;; This file is a part of Guile-SSH. ;; ;; Guile-SSH 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 3 of the ;; License, or (at your option) any later version. ;; ;; Guile-SSH 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 Guile-SSH. If not, see . ;;; Commentary: ;; This module provides implementation of "remote popen". That is, you may ;; create either input, output or bidirectional pipes to remote process with ;; the procedures exported by the module. ;; ;; These procedures are exported: ;; ;; open-remote-pipe ;; open-remote-pipe* ;; open-remote-input-pipe ;; open-remote-input-pipe* ;; open-remote-output-pipe ;; open-remote-output-pipe* ;; ;; Variables exported: ;; ;; OPEN_PTY ;; ;; See the Info documentation for the detailed description of these ;; procedures. ;;; Code: (define-module (ssh popen) #:use-module (ssh channel) #:export (open-remote-pipe open-remote-pipe* open-remote-input-pipe open-remote-input-pipe* open-remote-output-pipe open-remote-output-pipe* OPEN_PTY)) (define OPEN_PTY "t") ;; This procedure is taken from GNU Guile 3.0.0. ;; ;; Original comment: ;; ;; string-replace-substring By A. Wingo in ;; https://lists.gnu.org/archive/html/guile-devel/2014-03/msg00058.html ;; also in string-replace-substring guix:guix/utils.scm. (define (string-replace-substring str substring replacement) "Return a new string where every instance of @var{substring} in string @var{str} has been replaced by @var{replacement}. For example: @lisp (string-replace-substring \"a ring of strings\" \"ring\" \"rut\") @result{} \"a rut of struts\" @end lisp " (let ((sublen (string-length substring))) (with-output-to-string (lambda () (let lp ((start 0)) (cond ((string-contains str substring start) => (lambda (end) (display (substring/shared str start end)) (display replacement) (lp (+ end sublen)))) (else (display (substring/shared str start))))))))) (define (shell-quote s) "Quote string S for sh-compatible shells." (string-append "'" (string-replace-substring s "'" "'\\''") "'")) (define (open-remote-pipe session command mode) "Execute a COMMAND on the remote host using a SESSION with a pipe to it. Returns newly created channel port with the specified MODE." (let ((channel (make-channel session mode))) (unless channel (throw 'guile-ssh-error "Could not create a channel" session command mode)) (channel-open-session channel) (when (string-contains mode OPEN_PTY) (channel-request-pty channel)) (channel-request-exec channel command) channel)) (define (open-remote-pipe* session mode prog . args) "Execute a PROG with optional ARGS on the remote host using a SESSION with a pipe to it. Returns newly created channel port with the specified MODE." (open-remote-pipe session (string-join (cons (shell-quote prog) (map shell-quote args))) mode)) (define (open-remote-input-pipe session command) "Execute a COMMAND on the remote host using a SESSION with an input pipe to it. Returns newly created input channel port." (open-remote-pipe session command OPEN_READ)) (define (open-remote-input-pipe* session prog . args) "Execute a PROG with optional ARGS on the remote host using a SESSION with an input pipe to it. Returns newly created input channel port." (open-remote-pipe session (string-join (cons (shell-quote prog) (map shell-quote args))) OPEN_READ)) (define (open-remote-output-pipe session command) "Execute a COMMAND on the remote host using a SESSION with an input pipe to it. Returns newly created input channel port." (open-remote-pipe session command OPEN_WRITE)) (define (open-remote-output-pipe* session prog . args) "Execute a PROG with optional ARGS on the remote host using a SESSION with an output pipe to it. Returns newly created output channel port." (open-remote-pipe session (string-join (cons (shell-quote prog) (map shell-quote args))) OPEN_WRITE)) ;;; popen.scm ends here. guile-ssh-0.18.0/modules/ssh/server.scm000066400000000000000000000043461471416131000177640ustar00rootroot00000000000000;;; server.scm -- SSH server API. ;; Copyright (C) 2013 Artyom V. Poptsov ;; ;; This file is a part of Guile-SSH. ;; ;; Guile-SSH 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 3 of the ;; License, or (at your option) any later version. ;; ;; Guile-SSH 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 Guile-SSH. If not, see ;; . ;;; Commentary: ;; This module contains API that is used for SSH server. ;; ;; These methods are exported: ;; ;; %make-server ;; make-server ;; server-accept ;; server-set! ;; server-get ;; server-listen! ;; server-handle-key-exchange ;; server-message-get ;;; Code: (define-module (ssh server) #:use-module (ice-9 optargs) #:use-module (ssh log) #:export (server server? %make-server make-server server-accept server-set! server-get server-listen server-handle-key-exchange server-message-get)) ;; Set a SSH option if it is specified by the user (define-macro (server-set-if-specified! option) `(if ,option (server-set! server (quote ,option) ,option))) (define* (make-server #:key bindaddr bindport hostkey dsakey rsakey banner log-verbosity blocking-mode) "Make a new SSH server with the specified configuration.\n Return a new SSH server." (let ((server (%make-server))) (server-set-if-specified! bindaddr) (server-set-if-specified! bindport) (server-set-if-specified! hostkey) (server-set-if-specified! dsakey) (server-set-if-specified! rsakey) (server-set-if-specified! banner) (server-set-if-specified! log-verbosity) (server-set-if-specified! blocking-mode) server)) (unless (getenv "GUILE_SSH_CROSS_COMPILING") (load-extension "libguile-ssh" "init_server")) ;;; server.scm ends here guile-ssh-0.18.0/modules/ssh/session.scm000066400000000000000000000125271471416131000201410ustar00rootroot00000000000000;;; session.scm -- SSH session management. ;; Copyright (C) 2013-2024 Artyom V. Poptsov ;; ;; This file is a part of Guile-SSH. ;; ;; Guile-SSH 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 3 of the ;; License, or (at your option) any later version. ;; ;; Guile-SSH 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 Guile-SSH. If not, see . ;;; Commentary: ;; This module contains API that is used for SSH session management. ;; ;; These methods are exported: ;; ;; session? ;; %make-session ;; make-session ;; session-parse-config! ;; blocking-flush! ;; session-set! ;; session-get ;; get-protocol-version ;; connect! ;; disconnect! ;; connected? ;; authenticate-server ;; get-public-key-hash ;; write-known-host! ;; get-error ;;; Code: (define-module (ssh session) #:use-module (ice-9 optargs) #:use-module (ssh log) #:use-module (ssh version) #:export (session session? %make-session make-session session-parse-config! blocking-flush! session-set! session-get get-protocol-version connect! disconnect! connected? authenticate-server get-server-public-key write-known-host! get-error)) ;; Set a SSH option if it is specified by the user (define-macro (session-set-if-specified! option) `(if ,option (session-set! session (quote ,option) ,option))) (define (get-libssh-minor-version) (string->number (cadr (string-split (get-libssh-version) #\.)))) ;; This procedure is more convenient than primitive `%make-session', ;; but on other hand it should be a bit slower because of additional ;; checks. I think we can put up with this. -avp (define* (make-session #:key host port user ssh-dir identity add-identity knownhosts timeout timeout-usec ssh1 ssh2 log-verbosity ciphers-c-s ciphers-s-c compression-c-s compression-s-c proxycommand stricthostkeycheck compression compression-level nodelay callbacks (config #t) public-key-accepted-types) "Make a new SSH session with specified configuration.\n Return a new SSH session." (let ((session (%make-session))) (session-set-if-specified! host) (if config (begin (or host (throw 'guile-ssh-error "'config' is specified, but 'host' option is missed.")) (cond ((string? config) (%gssh-session-parse-config! session config)) ((boolean? config) (%gssh-session-parse-config! session #f)) (else (throw 'guile-ssh-error "Wrong 'config' value" config)))) (let ((libssh-minor-version (get-libssh-minor-version))) (if (>= libssh-minor-version 9) (session-set! session 'process-config? #f) (begin (format-log 'rare 'make-session (string-append "process-config? option is not available" " (using libssh 0.~a.)" " Falling back to setting the config to" " '/dev/null' to prevent reading the default" " configuration files." " See .") libssh-minor-version) (%gssh-session-parse-config! session "/dev/null"))))) (session-set-if-specified! port) (session-set-if-specified! user) (session-set-if-specified! ssh-dir) (session-set-if-specified! identity) (session-set-if-specified! add-identity) (session-set-if-specified! knownhosts) (session-set-if-specified! timeout) (session-set-if-specified! timeout-usec) (session-set-if-specified! ssh1) (session-set-if-specified! ssh2) (session-set-if-specified! log-verbosity) (session-set-if-specified! ciphers-c-s) (session-set-if-specified! ciphers-s-c) (session-set-if-specified! compression-c-s) (session-set-if-specified! compression-s-c) (session-set-if-specified! proxycommand) (session-set-if-specified! stricthostkeycheck) (session-set-if-specified! compression) (session-set-if-specified! compression-level) (session-set-if-specified! nodelay) (session-set-if-specified! callbacks) session)) (define* (session-parse-config! session #:optional file-name) "Parse an SSH config FILE-NAME and set SESSION options. If FILE-NAME is not set, the default SSH '~/.ssh/config' is used. Throw 'guile-ssh-error' on an error. Return value is undefined." (%gssh-session-parse-config! session file-name)) (unless (getenv "GUILE_SSH_CROSS_COMPILING") (load-extension "libguile-ssh" "init_session")) ;;; session.scm ends here guile-ssh-0.18.0/modules/ssh/sftp.scm000066400000000000000000000242261471416131000174310ustar00rootroot00000000000000;;; sftp.scm -- Procedures for working with SFTP. ;; Copyright (C) 2015-2022 Artyom V. Poptsov ;; ;; This file is a part of Guile-SSH. ;; ;; Guile-SSH 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 3 of the ;; License, or (at your option) any later version. ;; ;; Guile-SSH 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 Guile-SSH. If not, see . ;;; Commentary: ;; This module contains SFTP API procedures. ;; ;; The module exports: ;; sftp-session? ;; make-sftp-session ;; sftp-get-session ;; sftp-get-error ;; sftp-mkdir ;; sftp-rmdir ;; sftp-mv ;; sftp-symlink ;; sftp-readlink ;; sftp-chmod ;; sftp-unlink ;; sftp-open ;; sftp-file? ;; sftp-dir? ;; sftp-dir-open ;; sftp-dir-open-stream ;; sftp-dir-path ;; sftp-dir-session ;; sftp-dir-close ;; sftp-dir-eof? ;; sftp-dir-read ;; call-with-remote-input-file ;; call-with-remote-output-file ;; with-input-from-remote-file ;; with-output-to-remote-file ;; ;; These exported procedures are low-level ones and should not be used without ;; a good reason: ;; %make-sftp-session ;; %sftp-init ;; ;; See the Info documentation for the detailed description of these ;; procedures. ;;; Code: (define-module (ssh sftp) #:use-module (ice-9 receive) #:use-module (ice-9 streams) #:export (sftp-session? make-sftp-session sftp-get-session sftp-get-error sftp-mkdir sftp-rmdir sftp-mv sftp-symlink sftp-readlink sftp-chmod sftp-unlink ;; Low-level SFTP session procedures %make-sftp-session %sftp-init ;; File ports sftp-open sftp-file? ;; Directories sftp-dir? sftp-dir-open sftp-dir-open-stream sftp-dir-path sftp-dir-session sftp-dir-close sftp-dir-eof? sftp-dir-read ;; High-level operations on remote files call-with-remote-input-file call-with-remote-output-file with-input-from-remote-file with-output-to-remote-file)) ;;; Low-level SFTP session procedures. (define (%make-sftp-session ssh-session) "Make a new SFTP session using an SSH-SESSION without initialization of the session with a server. Throw 'guile-ssh-error' exception on an error." (%gssh-make-sftp-session ssh-session)) (define (%sftp-init sftp-session) "Initialize a SFTP-SESSION with the server. Throw 'guile-ssh-error' exception on an error, return value is undefined." (%gssh-sftp-init sftp-session)) ;;; Main SFTP session API. (define (make-sftp-session ssh-session) "Make a new SFTP session using an SSH-SESSION, initialize the session with a server. Return initialized SFTP session or throw 'guile-ssh-error' exception on an error" (let ((sftp-session (%gssh-make-sftp-session ssh-session))) (%gssh-sftp-init sftp-session) sftp-session)) (define (sftp-session? x) "Return #t if X is a SFTP session, #f otherwise." (%gssh-sftp-session? x)) (define (sftp-get-session sftp-session) "Get the parent SSH session for a SFTP-SESSION." (%gssh-sftp-get-session sftp-session)) (define (sftp-get-error sftp-session) "Get the last SFTP error from a SFTP-SESSION. Return the error name as a symbol, or throw 'guile-ssh-error' on if an error occurred in the procedure itself." (%gssh-sftp-get-error sftp-session)) (define* (sftp-mkdir sftp-session dirname #:optional (mode #o777)) "Create a directory DIRNAME using a SFTP-SESSION with permissions specified by a MODE. The permissions of the created file are (MODE & ~umask). If the MODE is omitted, #o777 is used." (%gssh-sftp-mkdir sftp-session dirname mode)) (define (sftp-rmdir sftp-session dirname) "Remove a directory DIRNAME. Throw 'guile-ssh-error' on an error. Return value is undefined." (%gssh-sftp-rmdir sftp-session dirname)) (define (sftp-mv sftp-session source dest) "Move or rename a file SOURCE into a DEST. Throw 'guile-ssh-error' on an error. Return value is undefined." (%gssh-sftp-mv sftp-session source dest)) (define (sftp-symlink sftp-session target dest) "Create a symbolic link to a TARGET in a DEST. Throw 'guile-ssh-error' on an error. Return value is undefined." (%gssh-sftp-symlink sftp-session target dest)) (define (sftp-readlink sftp-session path) "Read the value of a symbolic link pointed by a PATH. Return the value or '#f' on an error." (%gssh-sftp-readlink sftp-session path)) (define* (sftp-chmod sftp-session filename mode) "Change permissions of a FILENAME. Permissions are set to 'MODE & ~umask'. Throw 'guile-ssh-error' on an error. Return value is undefined." (%gssh-sftp-chmod sftp-session filename mode)) (define (sftp-unlink sftp-session filename) "Unlink (delete) a FILENAME. Throw 'guile-ssh-error' on an error. Return value is undefined." (%gssh-sftp-unlink sftp-session filename)) ;;; SFTP file API. (define* (sftp-open sftp-session filename flags #:optional (mode #o666)) "Open a FILENAME with permissions specified by MODE, return an open file port. Permissions are set to 'MODE & ~umask'; the default MODE is #o666. Throw 'guile-ssh-error' on an error." (%gssh-sftp-open sftp-session filename flags mode)) (define (sftp-file? x) "Return #t if X is an SFTP file port, #f otherwise." (%gssh-sftp-file? x)) ;;; High-Level operations on remote files. ;; Those procedures are partly based on GNU Guile's 'r4rs.scm'; the goal is to ;; provide a convenient API similar to Guile I/O API. (define (with-input-from-port port thunk) (let ((swaports (lambda () (set! port (set-current-input-port port))))) (dynamic-wind swaports thunk swaports))) (define (with-output-to-port port thunk) (let ((swaports (lambda () (set! port (set-current-output-port port))))) (dynamic-wind swaports thunk swaports))) (define (call-with-remote-input-file sftp-session filename proc) "Call a PROC with a remote file port opened for input using an SFTP-SESSION. PROC should be a procedure of one argument, FILENAME should be a string naming a file. The behaviour is unspecified if a file already exists. The procedure calls PROC with one argument: the port obtained by opening the named remote file for input. If the procedure returns, then the port is closed automatically and the values yielded by the procedure are returned. If the procedure does not return, then the port will not be closed automatically unless it is possible to prove that the port will never again be used for a read or write operation." (let ((input-file (sftp-open sftp-session filename O_RDONLY))) (call-with-values (lambda () (proc input-file)) (lambda vals (close-port input-file) (apply values vals))))) (define (call-with-remote-output-file sftp-session filename proc) "Call a PROC with a remote file port opened for output using an SFTP-SESSION. PROC should be a procedure of one argument, FILENAME should be a string naming a file. The behaviour is unspecified if a file already exists. The procedure calls PROC with one argument: the port obtained by opening the named remote file for output. If the procedure returns, then the port is closed automatically and the values yielded by the procedure are returned. If the procedure does not return, then the port will not be closed automatically unless it is possible to prove that the port will never again be used for a read or write operation." (let ((output-file-port (sftp-open sftp-session filename (logior O_WRONLY O_CREAT)))) (call-with-values (lambda () (proc output-file-port)) (lambda vals (close-port output-file-port) (apply values vals))))) (define (with-input-from-remote-file sftp-session filename thunk) "THUNK must be a procedure of no arguments, and FILENAME must be a string naming a file. The file must already exist. The file is opened for input, an input port connected to it is made the default value returned by 'current-input-port', and the THUNK is called with no arguments. When the THUNK returns, the port is closed and the previous default is restored. Returns the values yielded by THUNK. If an escape procedure is used to escape from the continuation of these procedures, their behavior is implementation dependent." (call-with-remote-input-file sftp-session filename (lambda (p) (with-input-from-port p thunk)))) (define (with-output-to-remote-file sftp-session filename thunk) "THUNK must be a procedure of no arguments, and FILENAME must be a string naming a file. The effect is unspecified if the file already exists. The file is opened for output, an output port connected to it is made the default value returned by 'current-output-port', and the THUNK is called with no arguments. When the THUNK returns, the port is closed and the previous default is restored. Returns the values yielded by THUNK. If an escape procedure is used to escape from the continuation of these procedures, their behavior is implementation dependent." (call-with-remote-output-file sftp-session filename (lambda (p) (with-output-to-port p thunk)))) (define (sftp-dir-open-stream sftp-session directory) "Open an SFTP directory. Return a ICE-9 stream of directory attributes." (let ((dir (sftp-dir-open sftp-session directory))) (make-stream (lambda (state) (if (sftp-dir-eof? dir) #f (cons state (sftp-dir-read dir)))) (sftp-dir-read dir)))) ;;; Load libraries. (unless (getenv "GUILE_SSH_CROSS_COMPILING") (load-extension "libguile-ssh" "init_sftp_session") (load-extension "libguile-ssh" "init_sftp_file") (load-extension "libguile-ssh" "init_sftp_dir")) ;;; sftp-session.scm ends here. guile-ssh-0.18.0/modules/ssh/shell.scm000066400000000000000000000154701471416131000175650ustar00rootroot00000000000000;;; shell.scm -- Remote shell. ;; Copyright (C) 2016, 2017, 2020 Artyom V. Poptsov ;; ;; This file is a part of Guile-SSH. ;; ;; Guile-SSH 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 3 of the ;; License, or (at your option) any later version. ;; ;; Guile-SSH 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 Guile-SSH. If not, see ;; . ;;; Commentary: ;; Remote shell. ;; ;; The module provides the following procedures: ;; rexec ;; which ;; pgrep ;; pkill ;; command-available? ;; loadavg ;; ;; See the Info documentation for detailed description of these exceptions and ;; aforementioned procedures. ;;; Code: (define-module (ssh shell) #:use-module (srfi srfi-11) #:use-module (ice-9 rdelim) #:use-module (ice-9 regex) #:use-module (ice-9 format) #:use-module (ice-9 receive) #:use-module (ice-9 ftw) #:use-module (srfi srfi-1) #:use-module (ssh channel) #:use-module (ssh popen) #:use-module (ssh dist node) #:use-module (ssh log) #:export (rexec which pgrep pkill command-available? guile-version loadavg)) (define (rexec session cmd) "Execute a command CMD on the remote side. Return two values: list of output lines returned by CMD and its exit code." (let* ((channel (open-remote-input-pipe session cmd)) (result (let loop ((line (read-line channel)) (result '())) (if (eof-object? line) (reverse result) (loop (read-line channel) (cons line result))))) (exit-status (channel-get-exit-status channel))) (close channel) (values result exit-status))) (define (which session program-name) "Check if a PROGRAM-NAME is available on a remote side. Return two values: a check result and a return code." (rexec session (format #f "which '~a'" program-name))) (define* (%guile-pgrep session pattern #:key (full? #f)) (node-eval (make-node session) `(begin (use-modules (ice-9 ftw) (ice-9 rdelim) (ice-9 format) (ice-9 regex) (srfi srfi-1)) (let ((procs (scandir "/proc" (lambda (e) (string-match "^[0-9]+" e))))) (fold (lambda (entry prev) (let* ((cmdline-file (format #f "/proc/~a/status" entry)) (cmdline-port (open-input-file cmdline-file))) (if cmdline-port (let ((cmdline (read-line cmdline-port))) (cond ((eof-object? cmdline) prev) ((and ,full? (string=? ,pattern cmdline)) (cons (string->number entry) prev)) ((string-match ,pattern cmdline) (cons (string->number entry) prev)) (else prev))) prev))) (quote ()) procs))))) (define* (%guile-pkill session pattern #:key (full? #f) (signal SIGTERM)) "Guile-SSH implementation of 'pkill' that uses Guile on the remote side. Note that this procedure won't work if Guile is missing on a target machine. Send a SIGNAL to a process which name matches to PATTERN on a remote machine represented by a SESSION. Return two values: a pkill result and a return code." (let ((pids (%guile-pgrep session pattern #:full? full?))) (format-log 'functions "[SCM] %guile-pkill" "pids: ~a" pids) (node-eval (make-node session) `(begin (for-each (lambda (pid) (kill pid ,signal)) (quote ,pids)) (quote ,pids))))) ;; We should use short '-f' option for pgrep and pkill instead of the long ;; version of it ('--full') because the long version was added on september ;; 2011 (according to the commit log of procps-ng [1]) and some systems may ;; not support it due to older procps. ;; ;; [1] https://gitlab.com/procps-ng/procps/commit/4581ac2240d3c2108c6a65ba2d19599195b512bc (define* (pgrep session pattern #:key (full? #f) (use-guile? #f)) "Check if a process with a PATTERN cmdline is available on a machine represented by a SESSION. Return two values: a check result and a return code." (if use-guile? (receive (result eval-number module-name lang-name) (%guile-pgrep session pattern #:full? full?) (values result 0)) (receive (result exit-code) (rexec session (format #f "pgrep ~a '~a'" (if full? "-f" "") pattern)) (values (map string->number result) exit-code)))) (define* (pkill session pattern #:key (full? #f) (signal SIGTERM) (use-guile? #f)) "Send a SIGNAL to a process which name matches to PATTERN on a remote machine represented by a SESSION. Return two values: a pkill result and a return code." (if use-guile? (receive (result eval-number module-name lang-name) (%guile-pkill session pattern #:full? full? #:signal signal) (values result 0)) (rexec session (format #f "pkill ~a --signal ~a '~a'" (if full? "-f" "") signal pattern)))) (define (command-available? session command) "check if COMMAND is available on a remote side." (receive (result rc) (which session command) (zero? rc))) (define (procps-available? session) "Check if procps is available on a NODE." (command-available? session "pgrep")) (define (guile-version session) "Get Guile version installed on a remote side, return the version string. Return #f if Guile is not installed." (receive (result rc) (rexec session "which guile > /dev/null && guile --version") (and (zero? rc) (car result)))) (define (loadavg session) "Get average load of a host using a SESSION." (receive (result exit-status) (rexec session "cat /proc/loadavg") (unless (zero? exit-status) (throw 'guile-ssh-error "Could not get average load for a host" session)) (string-split (car result) #\space))) ;;; shell.scm ends here. guile-ssh-0.18.0/modules/ssh/tunnel.scm000066400000000000000000000245041471416131000177610ustar00rootroot00000000000000;;; tunnel.scm -- SSH tunnels ;; Copyright (C) 2015-2021 Artyom V. Poptsov ;; ;; This file is a part of Guile-SSH. ;; ;; Guile-SSH 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 3 of the ;; License, or (at your option) any later version. ;; ;; Guile-SSH 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 Guile-SSH. If not, see . ;;; Commentary: ;; High-level API built upon the basic port forwarding facilities for managing ;; port forwards. ;;; Code: (define-module (ssh tunnel) #:use-module (rnrs io ports) #:use-module (srfi srfi-9) #:use-module (srfi srfi-9 gnu) #:use-module (srfi srfi-11) #:use-module (ice-9 receive) #:use-module (ice-9 threads) #:use-module (rnrs bytevectors) #:use-module (ssh session) #:use-module (ssh channel) #:export (make-tunnel tunnel? tunnel-reverse? tunnel-session tunnel-bind-address tunnel-port tunnel-host tunnel-host-port start-forward call-with-ssh-forward ;; Helper procedures make-tunnel-channel tunnel-open-forward-channel)) ;;; Tunnel type (define-record-type (%make-tunnel session timeout bind-address port host host-port reverse?) tunnel? (session tunnel-session) ; (timeout tunnel-timeout) ; (bind-address tunnel-bind-address) ; (port tunnel-port) ; (host tunnel-host) ; (host-port tunnel-host-port) ; (reverse? tunnel-reverse?)) ; (set-record-type-printer! (lambda (tunnel port) "Print information about a TUNNEL to a PORT." (let ((tunnel-address (number->string (object-address tunnel) 16))) (if (tunnel-reverse? tunnel) (format port "#" (tunnel-host tunnel) (tunnel-host-port tunnel) (if (tunnel-bind-address tunnel) (tunnel-bind-address tunnel) "*") (tunnel-port tunnel) tunnel-address) (format port "# ~a:~a ~a>" (tunnel-bind-address tunnel) (tunnel-port tunnel) (tunnel-host tunnel) (tunnel-host-port tunnel) tunnel-address))))) (define (make-tunnel-channel tunnel) (let ((channel (make-channel (tunnel-session tunnel)))) (unless channel (error "Could not make a channel" tunnel)) channel)) (define (tunnel-open-forward-channel tunnel) "Open a new forward channel for a TUNNEL. Return the newly created open channel, or throw an error if a channel could not be opened." (let ((channel (make-tunnel-channel tunnel))) (case (channel-open-forward channel #:source-host (tunnel-bind-address tunnel) #:local-port (tunnel-port tunnel) #:remote-host (tunnel-host tunnel) #:remote-port (tunnel-host-port tunnel)) ((ok) channel) (else => (lambda (res) (error "Could not open forward channel" tunnel res)))))) (define (tunnel-listen-forward tunnel) "Return value is undefined." (receive (result port) (channel-listen-forward (tunnel-session tunnel) #:address (tunnel-bind-address tunnel) #:port (tunnel-port tunnel)) ;; TODO: Handle port (or (eq? result 'ok) (error "Could not open forward channel" tunnel result)))) ;;; Procedures (define* (make-tunnel session #:key (bind-address "127.0.0.1") port host (host-port port) (timeout 1000) (reverse? #f)) "Make a new SSH tunnel using SESSION. The procedure returns a new object. In case of direct port forwarding (when REVERSE? is set to #f), a BIND-ADDRESS is a host from which the connections are originated, and a PORT is a port on which the tunnel will be listening to the incoming connections. A HOST and a HOST-PORT is a host and port to which the connections are forwarded. Setting REVERSE? to #t changes the direction of the tunnel and a reverse port forwarding tunnel will be created. In this case a server allocates a socket to listen to PORT on the remote side, and whenever a connection is made to this port, the connection is forwarded over the secure channel, and a connection is made to HOST and HOST-PORT from the local machine. HOST can be set to #f to tell the server to listen on all addresses and known protocol families. Setting a PORT to 0 tells the server to bind the first unprivileged port. The procedure does not binds ports nor transfers data to the port (in case of reverse port forwarding), you should start port forwarding by means of the procedures that operate on a object -- e.g. 'start-forward' or 'call-with-ssh-forward'." (let ((timeout (if (and timeout (> timeout 0)) timeout 1))) (%make-tunnel session timeout bind-address port host host-port reverse?))) (define-syntax-rule (p1->p2? p1 p2) "Return #t if P1 and P2 are open ports and P1 has data that can be read, #f otherwise." (and (not (port-closed? p1)) (not (port-closed? p2)) (char-ready? p1))) (define-syntax cond-io (syntax-rules (else <- -> =>) ((_ (p1 -> p2 => proc) ...) (cond ((p1->p2? p1 p2) (proc p1 p2)) ...)) ((_ (p1 <- p2 => proc) ...) (cond ((p1->p2? p2 p1) (proc p1 p2)) ...)) ((_ (p1 -> p2 => proc) ... (else exp ...)) (cond ((p1->p2? p1 p2) (proc p1 p2)) ... (else exp ...))) ((_ (p1 <- p2 => proc) ... (else exp ...)) (cond ((p1->p2? p2 p1) (proc p1 p2)) ... (else exp ...))))) (define (transfer port-1 port-2) "Transfer data from a PORT-1 to a PORT-2. Close both ports if reading from the PORT-1 returns EOF." (let ((data (get-bytevector-some port-1))) (if (not (eof-object? data)) (put-bytevector port-2 data) (begin (close port-1) (close port-2))))) (define (tunnel-timeout/s+us tunnel) "Get a TUNNEL timeout as two values: timeout in seconds and microseconds." (let ((timeout (tunnel-timeout tunnel))) (values (and timeout (quotient timeout 1000000)) (and timeout (remainder timeout 1000000))))) (define (main-loop tunnel sock idle-proc) "Start the main loop of a TUNNEL. Accept connections on SOCK, transfer data between SOCK and the remote side. Call IDLE-PROC as (idle-proc client-socket channel) when no data is available." (let-values (((timeout-s timeout-us) (tunnel-timeout/s+us tunnel))) (define (select-client client) (select (list client) '() '() timeout-s timeout-us)) (while (connected? (tunnel-session tunnel)) (catch #t (lambda () (let* ((channel (tunnel-open-forward-channel tunnel)) (client-connection (accept sock)) (client (car client-connection))) (while (channel-open? channel) (cond-io (client -> channel => transfer) (channel -> client => transfer) (else (let ((selected (select-client client))) (when (null? (car selected)) (idle-proc client channel)))))))) (const #t))))) (define (main-loop/reverse tunnel idle-proc) (define (tunnel-connect tunnel sock) "Make a connection for a reverse TUNNEL. The return value is unspecified." (connect sock AF_INET (inet-pton AF_INET (tunnel-host tunnel)) (tunnel-host-port tunnel))) (let ((timeout (tunnel-timeout tunnel))) (while (connected? (tunnel-session tunnel)) (receive (channel port) (channel-accept-forward (tunnel-session tunnel) 1000) (when channel (let ((sock (socket PF_INET SOCK_STREAM 0))) (tunnel-connect tunnel sock) (while (channel-open? channel) (cond-io (channel -> sock => transfer) (sock -> channel => transfer) (else ;; XXX: Very hacky. We should use something like 'select' ;; here. (when (channel-open? channel) (usleep timeout) (idle-proc sock channel))))))))))) (define* (start-forward tunnel #:optional (idle-proc (const #f))) "Start port forwarding for a TUNNEL. Call IDLE-PROC as (idle-proc client-socket channel) when no data is available to forward. If no IDLE-PROC is specified then a procedure that always returns #f is used instead." (if (tunnel-reverse? tunnel) (begin (tunnel-listen-forward tunnel) (main-loop/reverse tunnel idle-proc)) (let ((sock (socket PF_INET SOCK_STREAM 0))) (bind sock AF_INET (inet-pton AF_INET (tunnel-bind-address tunnel)) (tunnel-port tunnel)) (listen sock 10) (main-loop tunnel sock idle-proc) (close sock)))) (define (call-with-ssh-forward tunnel proc) "Call a procedure PROC as (proc channel) where CHANNEL is a channel that forwards all the received data to a remote side through a TUNNEL, and vice versa. Return the result the PROC call." (let ((channel (tunnel-open-forward-channel tunnel))) (dynamic-wind (const #f) (lambda () (proc channel)) (lambda () (channel-cancel-forward (channel-get-session channel) (tunnel-host tunnel) (tunnel-host-port tunnel)))))) ;;; tunnel.scm ends here. guile-ssh-0.18.0/modules/ssh/version.scm000066400000000000000000000042601471416131000201360ustar00rootroot00000000000000;;; version.scm -- Get information about versions. ;; Copyright (C) 2013-2022 Artyom V. Poptsov ;; ;; This file is a part of Guile-SSH. ;; ;; Guile-SSH 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 3 of the ;; License, or (at your option) any later version. ;; ;; Guile-SSH 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 Guile-SSH. If not, see . ;;; Commentary: ;; This module provides functions that is used for getting information ;; about current versions. ;; ;; These methods are exported: ;; ;; get-libssh-version ;; get-library-version ;; ;; `get-libssh-version' returns libssh version as a string in the ;; follwing format: ;; ;; ::= "." "." ;; ;; For example, "0.5.2". ;; ;; `get-library-version' returns version of the Guile-SSH library ;; as a string. ;;; Code: (define-module (ssh version) #:use-module (ssh log) #:export (get-libssh-version get-library-version get-crypto-library zlib-support? dsa-support? ;; Low-level procedures %get-libssh-version)) (unless (getenv "GUILE_SSH_CROSS_COMPILING") (load-extension "libguile-ssh" "init_version")) (define (get-libssh-version) "Get version of the libssh." (car (string-split (%get-libssh-version) #\/))) (define (get-crypto-library) "Get cryptographic library name with which libssh was compiled. Possible values are: 'openssl, 'gnutls" (string->symbol (cadr (string-split (%get-libssh-version) #\/)))) (define (zlib-support?) "Return #t if libssh was compiled wit zlib support, #f otherwise." (let ((version (string-split (%get-libssh-version) #\/))) (and (not (null? (cddr version))) (string=? "zlib" (caddr version))))) ;;; version.scm ends here guile-ssh-0.18.0/tests/000077500000000000000000000000001471416131000146405ustar00rootroot00000000000000guile-ssh-0.18.0/tests/.gitignore000066400000000000000000000001621471416131000166270ustar00rootroot00000000000000# -*- shell-script -*- *.log *.trs # Temporary test sub-directories. client-server dist keys popen shell tunnel guile-ssh-0.18.0/tests/Makefile.am000066400000000000000000000061601471416131000166770ustar00rootroot00000000000000## Config file for GNU Automake. ## ## Copyright (C) 2014-2023 Artyom V. Poptsov ## ## This file is part of Guile-SSH. ## ## Guile-SSH 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 3 of the ## License, or (at your option) any later version. ## ## Guile-SSH 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 Guile-SSH. If not, see . include $(top_srcdir)/build-aux/am/guilec if !CROSS_COMPILING SCM_TESTS = \ log.scm \ version.scm \ server.scm \ session.scm \ client-server.scm \ popen.scm \ shell.scm \ server-client.scm \ sssh-ssshd.scm \ key.scm \ tunnel.scm \ dist.scm TESTS = ${SCM_TESTS} TEST_EXTENSIONS = .scm AM_TESTS_ENVIRONMENT = \ abs_top_srcdir="$(abs_top_srcdir)"; export abs_top_srcdir; \ abs_top_builddir="$(abs_top_builddir)"; export abs_top_builddir; \ ORIGTERM=${TERM}; export ORIGTERM; \ TERM=xterm; export TERM; \ GUILE=$(GUILE); export GUILE; \ GUILE_WARN_DEPRECATED=no; export GUILE_WARN_DEPRECATED; \ GUILE_AUTO_COMPILE=0; export GUILE_AUTO_COMPILE; # LOG_COMPILER was introduced in Automake 1.12; don't expect "make # check" or "make distcheck" to work with earlier versions. SCM_LOG_COMPILER = \ ${top_builddir}/libtool \ -dlopen ${top_builddir}/libguile-ssh/libguile-ssh.la \ --mode=execute $(GUILE) AM_SCM_LOG_FLAGS = \ -L "$(top_srcdir)" \ -L "$(top_srcdir)/modules" \ -s EXTRA_DIST = \ ${SCM_TESTS} \ common.scm \ common/test-server.scm \ keys/dsakey \ keys/dsakey.pub \ keys/ecdsakey \ keys/ecdsakey.pub \ keys/rsakey \ keys/rsakey.pub \ keys/encrypted-ecdsa-key \ keys/encrypted-ecdsa-key.pub \ keys/encrypted-rsa-key \ keys/encrypted-rsa-key.pub \ keys/encrypted-dsa-key \ keys/encrypted-dsa-key.pub \ config ### Compile modules GOBJECTS = common.go ccachedir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache/ssh nobase_dist_ccache_DATA = $(GOBJECTS) guilec_warnings = \ -Wunbound-variable -Warity-mismatch \ -Wunused-variable -Wunused-toplevel guilec_opts = \ $(guilec_warnings) # TODO: Move environment setup to a separate file. guilec_env = \ GUILE_AUTO_COMPILE=0 \ GUILE_SYSTEM_EXTENSIONS_PATH="$(abs_top_builddir)/libguile-ssh/.libs/:${GUILE_SYSTEM_EXTENSIONS_PATH}" \ GUILE_LOAD_PATH="$(abs_top_srcdir)/modules" \ GUILE_LOAD_COMPILED_PATH="$(builddir)/ssh:$$GUILE_LOAD_COMPILED_PATH" .scm.go: $(AM_V_GUILEC)$(guilec_env) $(GUILEC) $(guilec_opts) \ --output=$@ $< ### LOG_DIRS = \ dist \ key \ client-server \ dist \ popen \ session \ server-client \ tunnel \ server \ shell \ sssh-ssshd \ version clean-local: -rm -rf $(LOG_DIRS) CLEANFILES = \ $(GOBJECTS) else CROSS_COMPILING TESTS = SCM_TESTS = endif CROSS_COMPILING guile-ssh-0.18.0/tests/README.org000066400000000000000000000175431471416131000163200ustar00rootroot00000000000000* Equivalence Classes [[https://en.wikipedia.org/wiki/Equivalence_partitioning][Equivalence classes]] for Guile-SSH. Implemented test cases marked with "[x]". ** =(ssh auth)= *** =userauth-agent!= | Parameter | Valid | Non-Valid | |-----------+-------------------------+-----------------------------| | session | - [x] connected session | - [x] non-session object | | | | - [x] non-connected session | |-----------+-------------------------+-----------------------------| *** =userauth-none!= | Parameter | Valid | Non-Valid | |-----------+-------------------------+-----------------------------| | session | - [x] connected session | - [x] non-session object | | | | - [x] non-connected session | |-----------+-------------------------+-----------------------------| *** =userauth-password!= | Parameter | Valid | Non-Valid | |-----------+-------------------------+-----------------------------| | session | - [x] connected session | - [x] non-session object | | | | - [x] non-connected session | |-----------+-------------------------+-----------------------------| | password | - [x] string | - [x] non-string object | |-----------+-------------------------+-----------------------------| *** =userauth-public-key!= | Parameter | Valid | Non-Valid | |-------------+-------------------------+-----------------------------| | session | - [x] connected session | - [x] non-session object | | | | - [x] non-connected session | |-------------+-------------------------+-----------------------------| | private-key | - [x] private key | - [x] non-key object | | | | - [x] public key | | | | - [ ] invalid key | |-------------+-------------------------+-----------------------------| *** =userauth-public-key/auto!= | Parameter | Valid | Non-Valid | |-----------+-------------------------+-----------------------------| | session | - [x] connected session | - [x] non-session object | | | | - [x] non-connected session | |-----------+-------------------------+-----------------------------| *** =userauth-public-key/try= | Parameter | Valid | Non-Valid | |------------+-------------------------+-----------------------------| | session | - [ ] connected session | - [ ] non-session object | | | | - [ ] non-connected session | |------------+-------------------------+-----------------------------| | public-key | - [ ] public key | - [ ] non-key object | | | | - [ ] invalid key | |------------+-------------------------+-----------------------------| *** =userauth-get-list= | Parameter | Valid | Non-Valid | |-----------+-------------------------+-----------------------------| | session | - [x] connected session | - [x] non-session object | | | | - [x] non-connected session | |-----------+-------------------------+-----------------------------| ** =(ssh channel)= ** =(ssh dist)= ** =(ssh key)= ** =(ssh message)= ** =(ssh popen)= ** =(ssh server)= ** =(ssh session)= *** =session?= | Parameter | Valid | Non-Valid | |-----------+-------------------------+-----------------------------| | session | - [x] session object | - [x] non-session object | |-----------+-------------------------+-----------------------------| *** =session-set!= | Parameter | Valid | Non-Valid | |-----------+----------------------+--------------------------| | session | - [x] session object | - [x] non-session object | |-----------+----------------------+--------------------------| | option | - [x] valid option | - [x] non-valid option | | | | - [x] non-symbol object | |-----------+----------------------+--------------------------| | value | - [x] valid value | - [x] non-valid value | |-----------+----------------------+--------------------------| *** =session-get= | Parameter | Valid | Non-Valid | |-----------+-------------------------------------+-------------------------------------------------------------| | session | - [x] session object: "session-get" | - [x] non-session object: "session-get, non-session object" | |-----------+-------------------------------------+-------------------------------------------------------------| | option | - [x] valid option: "session-get" | - [x] invalid option: "session-get, invalid option" | |-----------+-------------------------------------+-------------------------------------------------------------| *** =make-session= | Parameter | Valid | Non-Valid | |------------+--------------------------------------------------------------------------------------------------+-------------------------------------------------------------------------------------| | =#:config= | - [x] =#:config= and =#:host= is specified: "make-session, '#:config' and '#:host' is specified" | - [x] only =#:config= is specified: "make-session, only '#:config' is specified" | | | - [x] =#:config= is a boolean value: "make-session, '#:config' as a boolean value" | - [x] =#:config= is of non-string type: "make-session, wrong '#:config' value type" | |------------+--------------------------------------------------------------------------------------------------+-------------------------------------------------------------------------------------| *** =session-parse-config!= | Parameter | Valid | Non-Valid | |-----------+-------------------------------------------------------+-------------------------------------------------------------------------| | session | - [x] valid session: "session-parse-config!" | - [x] non-session object: "session-parse-config!, non-session object" | |-----------+-------------------------------------------------------+-------------------------------------------------------------------------| | config | - [x] valid config file name: "session-parse-config!" | - [x] non-valid config file: "session-parse-config!, wrong config file" | |-----------+-------------------------------------------------------+-------------------------------------------------------------------------| *** =connected?= | Parameter | Valid | Non-Valid | |-----------+--------------------------------------------------------------------+------------------------------------------------------------| | session | - [x] valid session: "connected?, check that we are not connected" | - [x] non-session object: "connected?, non-session object" | |-----------+--------------------------------------------------------------------+------------------------------------------------------------| ** =(ssh sftp)= ** =(ssh tunnel)= guile-ssh-0.18.0/tests/client-server.scm000066400000000000000000000636241471416131000201410ustar00rootroot00000000000000;;; client-server.scm -- Guile-SSH client is SUT. ;; Copyright (C) 2014, 2015, 2016, 2024 Artyom V. Poptsov ;; ;; This file is a part of Guile-SSH. ;; ;; Guile-SSH 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 3 of the ;; License, or (at your option) any later version. ;; ;; Guile-SSH 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 Guile-SSH. If not, see . (add-to-load-path (getenv "abs_top_srcdir")) (use-modules (srfi srfi-64) (srfi srfi-26) (ice-9 threads) (ice-9 rdelim) (ice-9 regex) (rnrs bytevectors) (rnrs io ports) (ssh server) (ssh session) (ssh auth) (ssh message) (ssh key) (ssh channel) (ssh log) (ssh tunnel) (ssh version) (srfi srfi-4) (tests common)) (test-begin-with-log "client-server") ;;; Global symbols (define topdir (getenv "abs_top_srcdir")) (define log (test-runner-aux-value (test-runner-current))) ;;; Helper procedures and macros (define (srvmsg message) "Print a server MESSAGE to the test log." (format log " server: ~a~%" message)) ;;; Testing of basic procedures. ;; Helper procedures. (define (simple-server-proc server) "start a SERVER that accepts a connection and handles a key exchange." (let ((s (server-accept server))) (server-handle-key-exchange s))) ;; Tests. (test-assert-with-log "connect!, disconnect!" (run-client-test ;; server (lambda (server) (let ((s (server-accept server))) (server-handle-key-exchange s))) ;; client (lambda () (call-with-connected-session (lambda (session) (and (connected? session) (begin (disconnect! session) (not (connected? session))))))))) (test-equal-with-log "get-protocol-version" 2 (run-client-test ;; server (lambda (server) (let ((s (server-accept server))) (server-handle-key-exchange s))) ;; client (lambda () (call-with-connected-session (lambda (session) (let ((version (get-protocol-version session))) (disconnect! session) version)))))) (test-assert-with-log "authenticate-server, not-known" 'not-known (run-client-test ;; server (lambda (server) (let ((s (server-accept server))) (server-handle-key-exchange s))) ;; client (lambda () (call-with-connected-session (lambda (session) (authenticate-server session)))))) (test-equal-with-log "authenticate-server, ok" 'ok (run-client-test ;; server (lambda (server) (let ((s (server-accept server))) (server-handle-key-exchange s))) ;; client (lambda () (let ((res (call-with-connected-session (lambda (session) (write-known-host! session) (authenticate-server session))))) (delete-file %knownhosts) res)))) (test-assert-with-log "get-public-key-hash" (run-client-test ;; server (lambda (server) (let ((s (server-accept server))) (server-handle-key-exchange s))) ;; client (lambda () (let ((hash-md5-bv #vu8(15 142 110 203 162 228 250 211 20 212 26 217 118 57 217 66)) (hash-md5-str "0f:8e:6e:cb:a2:e4:fa:d3:14:d4:1a:d9:76:39:d9:42") (hash-sha1-bv #vu8(20 65 56 155 119 45 84 163 50 26 59 92 215 159 139 5 229 174 84 80)) (hash-sha1-str "14:41:38:9b:77:2d:54:a3:32:1a:3b:5c:d7:9f:8b:05:e5:ae:54:50") (session (make-session-for-test))) (sleep 1) (connect! session) (authenticate-server session) (let* ((pubkey (get-server-public-key session)) (md5-res (get-public-key-hash pubkey 'md5)) (sha1-res (get-public-key-hash pubkey 'sha1))) (disconnect! session) (and (bytevector=? md5-res hash-md5-bv) (string=? (bytevector->hex-string md5-res) hash-md5-str) (bytevector=? sha1-res hash-sha1-bv) (string=? (bytevector->hex-string sha1-res) hash-sha1-str))))))) ;;; ;;; Authentication ;;; ;;; 'userauth-none!' ;; The procedure called with a wrong object as a parameter which leads to an ;; exception. (test-error-with-log "userauth-none!, session: non-session object" 'wrong-type-arg (userauth-none! "Not a session.")) ;; Client tries to authenticate using a non-connected session which leads to ;; an exception. (test-error-with-log "userauth-none!, session: non-connected session" 'wrong-type-arg (userauth-none! (make-session-for-test))) ;; Server replies with "success", client receives 'success. (test-equal-with-log "userauth-none!, session: connected session" 'success (run-client-test ;; server (lambda (server) (server-listen server) (let ((session (server-accept server))) (server-handle-key-exchange session) (start-session-loop session (lambda (msg) (message-auth-set-methods! msg '(none)) (message-reply-success msg))))) ;; client (lambda () (call-with-connected-session (lambda (session) (authenticate-server session) (userauth-none! session)))))) ;; Server replies with "default", client receives 'denied. (test-equal-with-log "userauth-none!, denied" 'denied (run-client-test ;; server (lambda (server) (server-listen server) (let ((session (server-accept server))) (server-handle-key-exchange session) (start-session-loop session (lambda (msg) (message-auth-set-methods! msg '(public-key)) (message-reply-default msg))))) ;; client (lambda () (call-with-connected-session (lambda (session) (authenticate-server session) (userauth-none! session)))))) ;; Server replies with "partial success", client receives 'partial. (test-equal-with-log "userauth-none!, partial" 'partial (run-client-test ;; server (lambda (server) (server-listen server) (let ((session (server-accept server))) (server-handle-key-exchange session) (start-session-loop session (lambda (msg) (message-auth-set-methods! msg '(none)) (message-reply-success msg 'partial))))) ;; client (lambda () (call-with-connected-session (lambda (session) (authenticate-server session) (userauth-none! session)))))) ;;; 'userauth-password!' ;; The procedure called with a wrong object as a parameter which leads to an ;; exception. (test-error-with-log "userauth-password!, session: non-session object" 'wrong-type-arg (userauth-password! "Not a session." "Password")) ;; Client tries to authenticate using a non-connected session which leads to ;; an exception. (test-error-with-log "userauth-password!, session: non-connected session" 'wrong-type-arg (userauth-password! (make-session-for-test) "Password")) ;; User tries to authenticate using a non-string object as a password. the ;; procedure raises an error. (test-error-with-log "userauth-password!, password: non-string object" 'wrong-type-arg (run-client-test ;; server (lambda (server) (server-listen server) (let ((session (server-accept server))) (server-handle-key-exchange session) (start-session-loop session (lambda (msg) (message-auth-set-methods! msg '(password)) (message-reply-success msg))))) ;; client (lambda () (call-with-connected-session (lambda (session) (userauth-password! session 123)))))) (test-equal-with-log "userauth-password!, success" 'success (run-client-test ;; server (lambda (server) (server-listen server) (let ((session (server-accept server))) (server-handle-key-exchange session) (start-session-loop session (lambda (msg) (message-auth-set-methods! msg '(password)) (message-reply-success msg))))) ;; client (lambda () (call-with-connected-session (lambda (session) (authenticate-server session) (userauth-password! session "password")))))) (test-equal-with-log "userauth-password!, denied" 'denied (run-client-test ;; server (lambda (server) (server-listen server) (let ((session (server-accept server))) (server-handle-key-exchange session) (start-session-loop session (lambda (msg) (message-auth-set-methods! msg '(password)) (message-reply-default msg))))) ;; client (lambda () (call-with-connected-session (lambda (session) (authenticate-server session) (userauth-password! session "password")))))) (test-equal-with-log "userauth-password!, partial" 'partial (run-client-test ;; server (lambda (server) (server-listen server) (let ((session (server-accept server))) (server-handle-key-exchange session) (start-session-loop session (lambda (msg) (message-auth-set-methods! msg '(password)) (message-reply-success msg 'partial))))) ;; client (lambda () (call-with-connected-session (lambda (session) (authenticate-server session) (userauth-password! session "password")))))) ;;; 'userauth-public-key!' ;; The procedure called with a wrong object as a parameter which leads to an ;; exception. (test-error-with-log "userauth-public-key!, wrong parameter" 'wrong-type-arg (userauth-public-key! "Not a session." (private-key-from-file %rsakey))) ;; Client tries to authenticate using a non-connected session which leads to ;; an exception. (test-error-with-log "userauth-public-key!, non-connected session" 'wrong-type-arg (userauth-public-key! (make-session-for-test) (private-key-from-file %rsakey))) ;; Client tries to use a non-key object for authentication, the procedure ;; raises an exception. (test-error-with-log "userauth-public-key!, private-key: non-key object" 'wrong-type-arg (run-client-test ;; server (lambda (server) (server-listen server) (let ((session (server-accept server))) (server-handle-key-exchange session) (start-session-loop session (lambda (msg) (message-reply-success msg))))) ;; client (lambda () (call-with-connected-session (lambda (session) (userauth-public-key! session "Non-key object.")))))) ;; Client tries to use a public key for authentication, the procedure raises ;; an exception. (test-error-with-log "userauth-public-key!, private-key: public key" 'wrong-type-arg (run-client-test ;; server (lambda (server) (server-listen server) (let ((session (server-accept server))) (server-handle-key-exchange session) (start-session-loop session (lambda (msg) (message-reply-success msg))))) ;; client (lambda () (call-with-connected-session (lambda (session) (userauth-public-key! session (public-key-from-file %rsakey-pub))))))) (let* ((version (get-libssh-version)) (version (map string->number (string-split version #\.)))) (when (and (zero? (car version)) (or (= (cadr version) 7) (and (= (cadr version) 8) (< (caddr version) 3)))) ;; XXX: This test fails because of the problems with ECDSA public key ;; authentication in libssh versions prior 0.8.3. (test-skip "userauth-public-key!, success"))) (test-equal-with-log "userauth-public-key!, success" 'success (run-client-test ;; server (lambda (server) (server-listen server) (let ((session (server-accept server))) (server-handle-key-exchange session) (start-session-loop session (lambda (msg) (message-reply-success msg))))) ;; client (lambda () (call-with-connected-session (lambda (session) (authenticate-server session) (let ((prvkey (private-key-from-file %ecdsakey))) (userauth-public-key! session prvkey))))))) (let* ((version (get-libssh-version)) (version (map string->number (string-split version #\.)))) (when (and (zero? (car version)) (>= (cadr version) 9)) (test-skip "userauth-public-key!, success (RSA)"))) (test-equal-with-log "userauth-public-key!, success (RSA)" 'success (run-client-test ;; server (lambda (server) (server-listen server) (let ((session (server-accept server))) (server-handle-key-exchange session) (start-session-loop session (lambda (msg) (message-reply-success msg))))) ;; client (lambda () (call-with-connected-session (lambda (session) (authenticate-server session) (let ((prvkey (private-key-from-file %rsakey))) (userauth-public-key! session prvkey))))))) ;;; 'userauth-public-key/auto!' ;; The procedure called with a wrong object as a parameter which leads to an ;; exception. (test-error-with-log "userauth-public-key/auto!, session: non-session object" 'wrong-type-arg (userauth-public-key/auto! "Not a session.")) ;; Client tries to authenticate using a non-connected session which leads to ;; an exception. (test-error-with-log "userauth-public-key/auto!, session: non-connected session" 'wrong-type-arg (userauth-public-key/auto! (make-session-for-test))) ;;; 'userauth-gssapi!' ;; The procedure called with a wrong object as a parameter which leads to an ;; exception. (test-error-with-log "userauth-gssapi!, wrong parameter" 'wrong-type-arg (userauth-gssapi! "Not a session.")) ;; Client tries to authenticate using a non-connected session which leads to ;; an exception. (test-error-with-log "userauth-gssapi!, not connected" 'wrong-type-arg (userauth-gssapi! (make-session-for-test))) ;;; ;; The procedure called with a wrong object as a parameter which leads to an ;; exception. (test-error-with-log "userauth-get-list, wrong parameter" 'wrong-type-arg (userauth-get-list "Not a session.")) (test-error-with-log "userauth-get-list, non-connected" 'wrong-type-arg (userauth-get-list (make-session-for-test))) ;; Server replies "default" with the list of allowed authentication ;; methods. Client receives the list. (test-equal-with-log "userauth-get-list" '(password public-key) (run-client-test ;; server (lambda (server) (let ((session (server-accept server))) (server-handle-key-exchange session) (start-session-loop session (lambda (msg) (message-auth-set-methods! msg '(password public-key)) (message-reply-default msg))))) ;; client (lambda () (call-with-connected-session (lambda (session) (authenticate-server session) (userauth-none! session) (userauth-get-list session)))))) ;;; Channel test ;; make, open, exec ;; TODO: Fix the bug: the procedure cannot be used to test errors. (define (call-with-connected-session/channel-test proc) (define max-tries 30) (define (loop count) (catch #t (lambda () (call-with-connected-session (lambda (session) (format-log/scm 'nolog "call-with-connected-session/channel-test" "connected in ~d tries: ~a" count session) (let ((result (authenticate-server session))) (format-log/scm 'nolog "call-with-connected-session/channel-test" "server authentication result: ~a" result) (when (equal? result 'error) (error "Could not authenticate server" session result))) (let ((result (userauth-none! session))) (format-log/scm 'nolog "call-with-connected-session/channel-test" "client authentication result: ~a" result)) ;; (unless (equal? result 'ok) ;; (error "Could not authenticate client" session result))) (proc session)))) (lambda args (format-log/scm 'nolog "make-session/channel-test" "Unable to connect in ~d tries~%" count) (sleep 1) (if (= count max-tries) (format-log/scm 'nolog "make-session/channel-test" "~a" "Giving up ...") (loop (1+ count)))))) (loop 1)) (test-assert-with-log "make-channel" (run-client-test ;; server (lambda (server) (start-server/exec server (const #t))) ;; client (lambda () (call-with-connected-session/channel-test make-channel)))) (test-assert-with-log "channel-get-session" (run-client-test ;; server (lambda (server) (start-server/exec server (const #t))) ;; client (lambda () (call-with-connected-session/channel-test (lambda (session) (let ((channel (make-channel session))) (eq? session (channel-get-session channel)))))))) (test-assert-with-log "channel-open-session" (run-client-test ;; server (lambda (server) (start-server/exec server (const #t))) ;; client (lambda () (call-with-connected-session/channel-test (lambda (session) (format-log/scm 'nolog "channel-open-session [client]" "session: ~a" session) (let ((channel (make-channel session))) (format-log/scm 'nolog "channel-open-session [client]" "channel: ~a" channel) (channel-open-session channel) (format-log/scm 'nolog "channel-open-session [client]" "channel 2: ~a" channel) (not (port-closed? channel)))))))) ;; Client sends "ping" as a command to execute, server replies with "pong" (test-assert-with-log "channel-request-exec" (run-client-test ;; server (lambda (server) (start-server/exec server (const #t))) ;; client (lambda () (call-with-connected-session/channel-test (lambda (session) (let ((channel (make-channel session))) (channel-open-session channel) (channel-request-exec channel "ping") (let ((res (read-line channel))) (and res (string=? "pong" res))))))))) ;; Client sends "uname" as a command to execute, server returns exit status 0. (test-assert-with-log "channel-request-exec, exit status" 0 (run-client-test ;; server (lambda (server) (start-server/exec server (const #t))) ;; client (lambda () (call-with-connected-session/channel-test (lambda (session) (let ((channel (make-channel session))) (channel-open-session channel) (channel-request-exec channel "exit status") (channel-get-exit-status channel))))))) (test-assert-with-log "channel-request-exec, printing a freed channel" (run-client-test ;; server (lambda (server) (start-server/exec server (const #t))) ;; client (lambda () (call-with-connected-session/channel-test (lambda (session) (let ((channel (make-channel session))) (format-log/scm 'nolog "channel-request-exec, printing a freed channel" "channel 0: ~a" channel) (channel-open-session channel) (format-log/scm 'nolog "channel-request-exec, printing a freed channel" "channel 1: ~a" channel) (channel-request-exec channel "exit status") (format-log/scm 'nolog "channel-request-exec, printing a freed channel" "channel 2: ~a" channel) (close channel) (format-log/scm 'nolog "channel-request-exec, printing a freed channel" "channel: ~a" channel) (string-match "#" (object->string channel)))))))) (test-error-with-log "channel-get-exit-status, freed channel" 'wrong-type-arg (run-client-test ;; server (lambda (server) (start-server/exec server (const #t))) ;; client (lambda () (call-with-connected-session (lambda (session) (authenticate-server session) (userauth-none! session) (let ((channel (make-channel session))) (channel-open-session channel) (channel-request-exec channel "exit status") (close channel) (channel-get-exit-status channel))))))) ;; data transferring ;; FIXME: Probably these TCs can be implemented more elegantly. (define (make-channel/dt-test session) (let ((c (make-channel session))) (channel-open-session c) c)) (test-assert-with-log "data transferring, string" (run-client-test ;; server (lambda (server) (start-server/dt-test server (lambda (channel) (let ((str (read-line channel))) (write-line str channel))))) ;; client (lambda () (call-with-connected-session/channel-test (lambda (session) (let ((channel (make-channel/dt-test session)) (str "Hello Scheme World!")) (write-line str channel) (poll channel (lambda args (let ((res (read-line channel))) (disconnect! session) (equal? res str)))))))))) (test-assert-with-log "data transferring, bytevector" (run-client-test ;; server (lambda (server) (use-modules (rnrs bytevectors) (rnrs io ports)) (start-server/dt-test server (lambda (channel) (let ((v (get-bytevector-n channel 10))) (put-bytevector channel v))))) ;; client (lambda () (call-with-connected-session/channel-test (lambda (session) (let* ((vect-size 10) (channel (make-channel/dt-test session)) (vect (make-bytevector vect-size 42))) (format-log/scm 'nolog "data transferring, bytevector" "vect: ~a" vect) (put-bytevector channel vect) (poll channel (lambda args (let ((res (get-bytevector-n channel vect-size))) (format-log/scm 'nolog "data transferring, bytevector" "res: ~a" res) (equal? res vect)))))))))) ;; This test checks if the client side is able to handle unexpected close of ;; the channel from the remote side. ;; ;; When a client tries to read from a channel that is abruptly closed by the ;; remote side (e.g. when a remote side is crashed) the reading procedure must ;; return EOF without issuing an error or a segmentation fault. (test-assert-with-log "data transferring, remote side abruptly closed" (run-client-test ;; server (lambda (server) (use-modules (rnrs bytevectors) (rnrs io ports)) (start-server/dt-test server (lambda (channel) (let ((v (get-bytevector-n channel 10))) (put-bytevector channel v) (kill (getpid) SIGKILL))))) ;; client (lambda () (call-with-connected-session/channel-test (lambda (session) (let* ((vect-size 10) (channel (make-channel/dt-test session)) (vect (make-bytevector vect-size 42))) (put-bytevector channel vect) (let loop ((data '()) (result (get-bytevector-n channel (/ vect-size 2)))) (if (eof-object? result) data (catch #t (lambda () (loop (cons result data) (get-bytevector-n channel (/ vect-size 2)))) (lambda err (format-log/scm 'nolog "data transferring, remote side abruptly closed" "err: ~a" err) #f)))))))))) ;;; ;;; Channels ;;; ;; Client opens a channel to a server, sends data and then sends EOF on the ;; channel. Server reads data and sends it back. Client checks if the ;; channel is closed for output, and reads the data. (test-assert-with-log "channel-send-eof" (run-client-test (lambda (server) (start-server/dt-test server (lambda (channel) (let ((str (read-line channel))) (write-line str channel))))) (lambda () (call-with-connected-session/channel-test (lambda (session) (let ((channel (make-channel/dt-test session)) (str "Hello Scheme World!")) (write-line str channel) (channel-send-eof channel) (and (input-port? channel) (not (output-port? channel)) (string=? (read-line channel) str)))))))) ;;; (define exit-status (test-runner-fail-count (test-runner-current))) (test-end "client-server") (exit (= 0 exit-status)) ;;; client-server.scm ends here. guile-ssh-0.18.0/tests/common.scm000066400000000000000000000703041471416131000166400ustar00rootroot00000000000000;;; common.scm -- Heper procedures and macros for tests. ;; Copyright (C) 2015-2024 Artyom V. Poptsov ;; ;; This file is a part of Guile-SSH. ;; ;; Guile-SSH 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 3 of the ;; License, or (at your option) any later version. ;; ;; Guile-SSH 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 Guile-SSH. If not, see . (define-module (tests common) #:use-module (srfi srfi-64) #:use-module (srfi srfi-26) #:use-module (ice-9 rdelim) #:use-module (ice-9 format) #:use-module (ice-9 regex) #:use-module (ice-9 popen) #:use-module (ice-9 threads) #:use-module (ssh session) #:use-module (ssh channel) #:use-module (ssh server) #:use-module (ssh auth) #:use-module (ssh log) #:use-module (ssh message) #:use-module (ssh version) #:export (;; Variables %topdir %topbuilddir %knownhosts %config %addr %rsakey %rsakey-pub %dsakey %dsakey-pub %ecdsakey %ecdsakey-pub %ecdsakey-encrypted %rsakey-encrypted %dsakey-encrypted ;; Procedures sanitize-string get-unused-port set-port! test-begin-with-log test-assert-with-log test-error-with-log test-error-with-log/= test-error-with-log/match test-equal-with-log start-session-loop make-session-for-test make-server-for-test make-libssh-log-printer call-with-connected-session call-with-connected-session/shell start-server-loop start-server/dt-test start-server/dist-test start-server/exec run-client-test run-server-test setup-test-suite-logging! setup-test-logging! format-log/scm poll)) (define %topdir (getenv "abs_top_srcdir")) (define %topbuilddir (getenv "abs_top_builddir")) (define %guile (getenv "GUILE")) (define %addr "127.0.0.1") (define *port* 12400) ;; Keys (define %rsakey (format #f "~a/tests/keys/rsakey" %topdir)) (define %rsakey-pub (format #f "~a/tests/keys/rsakey.pub" %topdir)) (define %dsakey (format #f "~a/tests/keys/dsakey" %topdir)) (define %dsakey-pub (format #f "~a/tests/keys/dsakey.pub" %topdir)) (define %ecdsakey (format #f "~a/tests/keys/ecdsakey" %topdir)) (define %ecdsakey-pub (format #f "~a/tests/keys/ecdsakey.pub" %topdir)) (define %ecdsakey-encrypted (format #f "~a/tests/keys/encrypted-ecdsa-key" %topdir)) (define %rsakey-encrypted (format #f "~a/tests/keys/encrypted-rsa-key" %topdir)) (define %dsakey-encrypted (format #f "~a/tests/keys/encrypted-dsa-key" %topdir)) (define (format-log/scm level proc-name message . args) "Format a log MESSAGE, append \"[SCM]\" to a PROC-NAME." (apply format-log level (string-append "[SCM] " proc-name) message args)) (define %knownhosts (format #f "~a/tests/knownhosts" (getenv "abs_top_builddir"))) (define %config (format #f "~a/tests/config" %topdir)) (define (sanitize-string string) "Replace all problematic chars in a STRING with '-'" (string-map (lambda (char) (case char ((#\, #\space #\! #\/) #\-) (else char))) string)) ;; Pass the test case NAME as the userdata to the libssh log (define-syntax test-assert-with-log (syntax-rules () ((_ name body ...) (test-assert name (begin (setup-test-logging! name) (set-log-userdata! name) body ...))))) ;; Ensure that the specific ERROR is raised during the test, check the error ;; with HANDLER. (define-syntax test-error-with-log/handler (syntax-rules () ((_ name expr handler) (test-assert-with-log name (catch #t (lambda () expr #f) handler))))) ;; Ensure that the specific ERROR is raised during the test and the error is ;; raised with the specified MESSAGE. (define-syntax-rule (test-error-with-log/= name error expected-message expr) (test-error-with-log/handler name expr (lambda (key . args) (if (equal? key error) (let* ((message (cadr args)) (result (string=? message expected-message))) (unless result (format-log/scm 'nolog name (string-append "Messages do not match: " "expected \"~a\", got \"~a\"") result expected-message)) result) (begin (format-log/scm 'nolog name (string-append "Errors do not match: " "expected '~a', got '~a' (args: ~a)") error key args) #f))))) (define-syntax-rule (test-error-with-log/match name error expected-message expr) (test-error-with-log/handler name expr (lambda (key . args) (if (equal? key error) (let* ((message (cadr args)) (result (string-match expected-message message))) (unless result (format-log/scm 'nolog name (string-append "Messages do not match: " "expected \"~a\", got \"~a\"") result expected-message)) result) (begin (format-log/scm 'nolog name (string-append "Errors do not match: " "expected '~a', got '~a' (args: ~a)") error key args) #f))))) ;; Ensure that the specific ERROR is raised during the test. (define-syntax test-error-with-log (syntax-rules () ((_ name error expr) (test-error-with-log/handler name expr (lambda (key . args) (let ((result (equal? key error))) (unless result (format-log/scm 'nolog name (string-append "Errors do not match: " "expected ~a, got ~a (args: ~a)") error key args)) result)))) ((_ name expr) (test-error-with-log/handler name expr (const #t))))) (define-syntax test-equal-with-log (syntax-rules () ((_ name expected body ...) (test-equal name expected (begin (setup-test-logging! name) (set-log-userdata! name) body ...))))) (define (start-session-loop session body) (let session-loop ((msg (server-message-get session)) (msg-counter 0)) (format-log/scm 'nolog "start-session-loop" "message: ~a" msg) (when msg (format-log/scm 'nolog "start-session-loop" "message being handled: ~a" msg) (body msg) (format-log/scm 'nolog "start-session-loop" "message handled: ~a" msg)) (if (connected? session) (begin (format-log/scm 'nolog "start-session-loop" "message counter: ~a" msg-counter) (session-loop (server-message-get session) (1+ msg-counter))) (format-log/scm 'nolog "start-session-loop" "disconnected; message counter: ~a" msg-counter)))) (define (make-session-for-test) "Make a session with predefined parameters for a test." (format-log/scm 'nolog "make-session-for-test" "host: ~a; port: ~a" %addr *port*) (make-session #:host %addr #:port *port* #:timeout 10 ;seconds #:user "bob" #:knownhosts %knownhosts #:log-verbosity 'functions)) (define mtx (make-mutex 'allow-external-unlock)) (define (make-server-for-test) "Make a server with predefined parameters for a test." (lock-mutex mtx) (dynamic-wind (const #f) (lambda () ;; FIXME: This hack is aimed to give every server its own unique ;; port to listen to. Clients will pick up new port number ;; automatically through global `port' symbol as well. (set! *port* (get-unused-port)) (format-log/scm 'nolog "make-server-for-test" "bindaddr: ~a; bindport: ~a" %addr *port*) (let ((s (make-server #:bindaddr %addr #:bindport *port* #:rsakey %rsakey #:dsakey (and (dsa-support?) %dsakey) #:log-verbosity 'functions))) (format-log/scm 'nolog "make-server-for-test" "***** bindaddr: ~a; bindport: ~a" %addr *port*) (server-listen s) s)) (lambda () (unlock-mutex mtx)))) (define (call-with-connected-session proc) "Call the one-argument procedure PROC with a freshly created and connected SSH session object, return the result of the procedure call. The session is disconnected when the PROC is finished." (let ((session (make-session-for-test))) (format-log/scm 'nolog "call-with-connected-session" "session: ~a" session) (dynamic-wind (lambda () (format-log/scm 'nolog "call-with-connected-session" "~a" "connecting...") (let ((result (connect! session))) (format-log/scm 'nolog "call-with-connected-session" "result: ~a" result) (unless (equal? result 'ok) (format-log/scm 'nolog "call-with-connected-session" "ERROR: Could not connect to a server: ~a" result) (error "Could not connect to a server" session result)))) (lambda () (proc session)) (lambda () (disconnect! session))))) (define (call-with-connected-session/shell proc) "Make a session for a shell test." (call-with-connected-session (lambda (session) (format-log/scm 'nolog "call-with-connected-session/shell" "session: ~a" session) (let ((auth-result (authenticate-server session))) (format-log/scm 'nolog "call-with-connected-session/shell" "server auth result: ~a" auth-result)) (let ((auth-result (userauth-none! session))) (format-log/scm 'nolog "call-with-connected-session/shell" "client auth result: ~a" auth-result)) (proc session)))) ;;; Port helpers. (define (port-in-use? port-number) "Return #t if a port with a PORT-NUMBER isn't used, #f otherwise." (let ((sock (socket PF_INET SOCK_STREAM 0))) (catch #t (lambda () (bind sock AF_INET INADDR_LOOPBACK port-number) (close sock) #f) (lambda args (close sock) #t)))) (define get-unused-port (let ((port-num (+ 10000 (random 2345 (random-state-from-platform)))) (mtx (make-mutex 'allow-external-unlock)) (used-ports '())) (lambda () "Get an unused port number." (lock-mutex mtx) (let loop ((num port-num)) (if (or (port-in-use? num) (member num used-ports)) (loop (1+ num)) (begin (format-log/scm 'nolog "get-unused-port" "port chosen: ~a" num) (set! used-ports (cons num used-ports)) (set! port-num (+ num 1)) (unlock-mutex mtx) num)))))) (define (set-port! port) (set! *port* port)) ;;; (define (poll port proc) "Poll a PORT, call a PROC when data is available." (format-log/scm 'nolog "poll" "Polling ~a ..." port) (let p ((ready? (char-ready? port)) (n 1)) (if ready? (begin (format-log/scm 'nolog "poll" "Polling ~a ... done in ~a tries" port n) (proc port)) (if (not (port-closed? port)) (p (char-ready? port) (+ n 1)) (error "Port is closed" port))))) ;;; Test Servers (define (start-server-loop server proc) "Start a SERVER loop, call PROC on incoming sessions." (define (state:init) (format-log/scm 'nolog "start-server-loop [state:init]" "server: ~a" server) (catch #t (lambda () (server-listen server) (state:accept)) (lambda (key . args) (format-log/scm 'nolog "start-server-loop" "ERROR: ~a: ~a" key args) (state:init)))) (define (state:accept) (format-log/scm 'nolog "start-server-loop [state:accept]" "server: ~a" server) (let ((session (server-accept server))) (format-log/scm 'nolog "start-server-loop [state:accept]" "session: ~a" session) (server-handle-key-exchange session) (format-log/scm 'nolog "start-server-loop [state:accept]" "~a" "key exchange handled") (proc session) (state:accept))) (state:init)) (define (start-server/dt-test server rwproc) (start-server-loop server (lambda (session) (start-session-loop session (lambda (msg) (case (car (message-get-type msg)) ((request-channel-open) (let ((channel (message-channel-request-open-reply-accept msg))) (poll channel rwproc))) (else (message-reply-success msg)))))))) (define %guile-version-string "\ GNU Guile 2.2.3 Copyright (C) 1995-2017 Free Software Foundation, Inc. Guile comes with ABSOLUTELY NO WARRANTY; for details type `,show w'. This program is free software, and you are welcome to redistribute it under certain conditions; type `,show c' for details. Enter `,help' for help. scheme@(guile-user)> ") (define (start-server/exec server body) "Start SERVER for a command execution test." (define *channel* #f) (define (state:message-handle-exec message session) (format-log/scm 'nolog "start-server/exec" "state:message-handle-exec: message: ~A" message) (let ((command (exec-req:cmd (message-get-req message)))) (format-log/scm 'nolog "start-server/exec" "command: ~S" command) (cond ((or (string=? command "'ping'") (string=? command "ping")) (message-reply-success message) (channel-request-send-exit-status *channel* 0) (write-line "pong" *channel*) (catch #t (lambda () (channel-send-eof *channel*)) (lambda args (format-log/scm 'nolog "start-server/exec" "ERROR: ~a" args)))) ((or (string=? command "'uname'") (string=? command "uname")) ;; For exit status testing (body session message *channel*)) ((string=? command "exit status") ; For exit status testing (message-reply-success message) (channel-request-send-exit-status *channel* 0)) ((string=? command "cat /proc/loadavg") (message-reply-success message) (write-line "0.01 0.05 0.10 4/1927 242011" *channel*) (channel-request-send-exit-status *channel* 0) (channel-send-eof *channel*)) ((string=? command "which guile > /dev/null && guile --version") (write-line %guile-version-string *channel*) (message-reply-success message) (channel-request-send-exit-status *channel* 0) (catch #t (lambda () (channel-send-eof *channel*)) (lambda args (format-log/scm 'nolog "start-server/exec" "ERROR: ~a" args)))) ;; "pgrep" ((string-match "pgrep.*process-1.*" command) (format-log/scm 'nolog "start-server/exec" "pgrep command: ~a" command) (write-line 12345 *channel*) (message-reply-success message) (channel-request-send-exit-status *channel* 0) (channel-send-eof *channel*)) ((or (string=? command "'guile -q'") (string=? command "'guile' '-q'")) (message-reply-success message) (display %guile-version-string *channel*) (body session message *channel*)) (else (message-reply-success message) (write-line command *channel*) (channel-request-send-exit-status *channel* 0) (catch #t (lambda () (channel-send-eof *channel*)) (lambda args (format-log/scm 'nolog "start-server/exec" "ERROR: ~a" args))))))) (define (state:handle-tcpip-forward message) (let* ((proc (lambda (session message user-data) (let ((type (message-get-type message)) (req (message-get-req message))) (format (current-error-port) "global req: type: ~a~%" type) (case (cadr type) ((global-request-tcpip-forward) (let ((pnum (global-req:port req))) (format (current-error-port) "global req: port: ~a~%" pnum) (message-reply-success message pnum))) ((global-request-cancel-tcpip-forward) (message-reply-success message 1)))))) (callbacks `((user-data . #f) (global-request-callback . ,proc)))) (session-set! (message-get-session message) 'callbacks callbacks) (message-reply-success message 1))) (define (state:process-message message) (format-log/scm 'nolog "start-server/exec" "message: ~a" message) (let ((message-type (message-get-type message))) (format-log/scm 'nolog "start-server/exec" "message-type: ~a" message-type) (case (car message-type) ((request-channel-open) (set! *channel* (message-channel-request-open-reply-accept message)) (case (cadr message-type) ((channel-direct-tcpip) (write-line (read-line *channel*) *channel*)))) ((request-channel) (state:message-handle-request-channel message message-type)) ((request-global) (state:handle-tcpip-forward message)) (else (message-reply-success message))))) (define (state:message-handle-request-channel message message-type) (let ((subtype (cadr message-type))) (format-log/scm 'nolog "start-server/exec" "message-subtype: ~a" subtype) (case subtype ((channel-request-exec) (state:message-handle-exec message (message-get-session message))) (else (message-reply-success message))))) (define (state:init) (start-server-loop server (lambda (session) (format-log/scm 'nolog "start-server/exec" "session: ~a" session) (start-session-loop session state:process-message)))) (state:init)) (define (start-server/dist-test server) (server-listen server) (let ((session (server-accept server))) (server-handle-key-exchange session) (let* ((proc (lambda (session message user-data) (let ((type (message-get-type message)) (req (message-get-req message))) (format (current-error-port) "global req: type: ~a~%" type) (case (cadr type) ((global-request-tcpip-forward) (let ((pnum (global-req:port req))) (format (current-error-port) "global req: port: ~a~%" pnum) (message-reply-success message pnum))) ((global-request-cancel-tcpip-forward) (message-reply-success message 1)))))) (callbacks `((user-data . #f) (global-request-callback . ,proc)))) (session-set! session 'callbacks callbacks)) (start-session-loop session (lambda (msg type) (message-reply-success msg))))) ;;; Tests (define (multifork . procs) "Execute each procedure from PROCS list in a separate process. The last procedure from PROCS is executed in the main process; return the result of the main procedure." (format-log/scm 'nolog "multifork" "procs 1: ~a~%" procs) (let* ((len (length procs)) (mainproc (car (list-tail procs (- len 1)))) (procs (list-head procs (- len 1))) (pids (map (lambda (proc) (let ((pid (primitive-fork))) (if (zero? pid) (dynamic-wind (lambda () (format-log/scm 'nolog "multifork" "Running proc ...~%")) proc (lambda () ;; This handler makes sure the child ;; process exits when PROC exit, be it a ;; non-local exit or a normal return. (format-log/scm 'nolog "multifork" "Exiting ...~%") (primitive-exit 0))) (begin (format-log/scm 'nolog "multifork" "PID: ~a~%" pid) pid)))) procs))) (format-log/scm 'nolog "multifork" "mainproc: ~a~%" mainproc) (format-log/scm 'nolog "multifork" "PIDs: ~a~%" pids) (dynamic-wind (const #f) (lambda () (mainproc pids)) (lambda () (format-log/scm 'nolog "multifork" "killing spawned processes ~a ...~%" pids) (catch #t (lambda () (for-each (cut kill <> SIGTERM) pids)) (lambda args (format-log/scm 'nolog "multifork" "ERROR: Could not kill process ~a: ~a~%" pids args))) (format-log/scm 'nolog "multifork" "waiting for processes status ~a ...~%" pids) (catch #t (lambda () (for-each waitpid pids)) (lambda args (format-log/scm 'nolog "multifork" "ERROR: Could not wait for PIDS ~a: ~a" pids args))))))) ;; "Run a SERVER-PROC in newly created process. The server passed to a ;; SERVER-PROC as an argument. CLIENT-PROC is expected to be a thunk that should ;; be executed in the parent process. The procedure returns a result of ;; CLIENT-PROC call." (define-syntax-rule (run-client-test server-proc client-proc) (let ((test-suite-name (car (test-runner-group-stack (test-runner-current)))) (test-name (test-runner-test-name (test-runner-current)))) (format-log/scm 'nolog "run-client-test" "Making a server ...") (let ((port (get-unused-port))) (set-port! port) (format-log/scm 'nolog "run-client-test" "Spawning processes ...") (multifork ;; server (lambda () (execle %guile (environ) %guile "-L" (format #f "~a/" %topdir) "-L" (format #f "~a/modules/" %topdir) "-e" "main" "-s" (format #f "~a/tests/common/test-server.scm" %topdir) test-suite-name test-name (number->string port) (format #f "~S" (quote server-proc))) (format-log/scm 'nolog "run-client-test" "Could not spawn process!") (exit 1)) ;; client (lambda (pids) (format-log/scm 'nolog "run-client-test" "PIDs: ~a" pids) ;; Wait for synchronization. (let ((run-file (format #f "~a/~a-server.run" test-suite-name (sanitize-string test-name)))) (let loop ((tries 100)) (if (zero? tries) (begin (format-log/scm 'nolog "run-client-test" "Client process failed: ~a" (car pids)) (exit 1)) (unless (file-exists? run-file) (format-log/scm 'nolog "run-client-test" "wait: ~a ..." tries) (usleep (round (/ 1000000 tries))) (loop (- tries 1))))) (delete-file run-file)) (client-proc)))))) (define (run-server-test client-proc server-proc) "Run a CLIENT-PROC in newly created process. A session is passed to a CLIENT-PROC as an argument. SERVER-PROC is called with a server as an argument. The procedure returns a result of SERVER-PROC call." (let ((server (make-server-for-test)) (session (make-session-for-test))) (multifork ;; server (lambda () (dynamic-wind (const #f) (lambda () (client-proc session)) (lambda () (primitive-exit 1)))) ;; client (lambda (pids) (server-proc server))))) ;;; Logging (define (make-libssh-log-printer log-file) "Make a libssh log printer with output to a LOG-FILE. Return the log printer." (let ((p (open-output-file log-file))) (lambda (priority function message userdata) (format p "[~a, \"~a\", ~a]: ~a~%" (strftime "%Y-%m-%dT%H:%M:%S%z" (localtime (current-time))) userdata priority message)))) (define (setup-libssh-logging! log-file) "Setup libssh logging for a test suite with output to a LOG-FILE." (let ((log-printer (make-libssh-log-printer log-file))) (set-logging-callback! log-printer))) (define (setup-error-logging! log-file) "Setup error logging for a test suite with output to a LOG-FILE." (set-current-error-port (open-output-file log-file))) (define (setup-test-suite-logging! test-name) "Setup error logging for a TEST-SUITE." (let ((libssh-log-file (string-append test-name "/0-libssh.log")) (errors-log-file (string-append test-name "/0-errors.log"))) (unless (file-exists? test-name) (mkdir test-name)) (setup-libssh-logging! libssh-log-file) (setup-error-logging! errors-log-file))) (define (setup-test-logging! test-name) (let* ((test-suite-name (car (test-runner-group-stack (test-runner-current)))) (libssh-log-file (format #f "~a/~a-libssh.log" test-suite-name (sanitize-string test-name))) (errors-log-file (format #f "~a/~a-errors.log" test-suite-name (sanitize-string test-name)))) (unless (file-exists? test-suite-name) (mkdir test-suite-name)) (setup-libssh-logging! libssh-log-file) (setup-error-logging! errors-log-file))) (define (test-begin-with-log test-name) (set-log-verbosity! 'functions) (setup-test-suite-logging! test-name) (test-begin test-name)) ;;; common.scm ends here guile-ssh-0.18.0/tests/common/000077500000000000000000000000001471416131000161305ustar00rootroot00000000000000guile-ssh-0.18.0/tests/common/test-server.scm000077500000000000000000000034521471416131000211260ustar00rootroot00000000000000(use-modules (ice-9 rdelim) (tests common) (ssh auth) (ssh channel) (ssh dist) (ssh key) (ssh message) (ssh popen) (ssh server) (ssh session) (ssh tunnel) (ssh log) (ssh server) (ssh version)) (define (main args) (let ((test-suite-name (list-ref args 1)) (test-name (list-ref args 2))) (define (log message) (let ((port (open-file (string-append test-suite-name "/log.txt") "a+"))) (format port "~s: ~a~%" (strftime "%Y-%m-%d %H:%M:%S" (localtime (current-time))) message) (close port))) (unless (file-exists? test-suite-name) (mkdir test-suite-name)) (log args) (set-log-userdata! test-name) (setup-test-suite-logging! (format #f "~a/~a-server" test-suite-name (sanitize-string test-name))) (let* ((port (string->number (list-ref args 3))) (handler (eval-string (list-ref args 4))) (s (make-server #:bindaddr %addr #:bindport port #:rsakey %rsakey #:dsakey (and (dsa-support?) %dsakey) #:log-verbosity 'functions))) (server-listen s) (let ((p (open-output-file (format #f "~a/~a-server.run" test-suite-name (sanitize-string test-name))))) (format p "~a~%" (getpid)) (close p)) (usleep 100) (handler s)))) guile-ssh-0.18.0/tests/config000066400000000000000000000001451471416131000160300ustar00rootroot00000000000000Host example Hostname example.org Port 2222 user alice guile-ssh-0.18.0/tests/dist.scm000066400000000000000000000224461471416131000163170ustar00rootroot00000000000000;;; dist.scm -- Testing of the distributed forms ;; Copyright (C) 2015, 2016, 2017, 2018, 2019, 2020 Artyom V. Poptsov ;; ;; This file is a part of Guile-SSH. ;; ;; Guile-SSH 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 3 of the ;; License, or (at your option) any later version. ;; ;; Guile-SSH 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 Guile-SSH. If not, see . (add-to-load-path (getenv "abs_top_srcdir")) (use-modules (srfi srfi-64) (ice-9 receive) (ice-9 rdelim) (ssh session) (ssh key) (ssh auth) (ssh message) (ssh server) (ssh log) (ssh dist) (ssh dist job) (ssh dist node) (tests common)) (set-log-verbosity! 'functions) (test-begin-with-log "dist") ;;; (test-assert-with-log "make-node" (run-client-test ;; Server (lambda (server) (start-server/exec server (const #t))) ;; Client (lambda () (call-with-connected-session/shell (lambda (session) (let ((n (make-node session))) (and n (eq? (node-session n) session)))))))) (test-equal "split, 1" '((a b) (c d) (e f g)) (split '(a b c d e f g) 3)) (test-equal "split, 2" '((a)) (split '(a) 2)) (test-assert-with-log "make-job" (run-client-test ;; Server (lambda (server) (start-server/exec server (const #f))) ;; Client (lambda () (call-with-connected-session/shell (lambda (session) (let* ((node (make-node session)) (data '(1 2 3)) (proc '(lambda (n) (1+ n))) (j (make-job 'map node data proc))) (and (eq? (job-type j) 'map) (eq? (job-node j) node) (eq? (job-data j) data) (eq? (job-proc j) proc)))))))) (test-assert-with-log "set-job-node" (run-client-test ;; Server (lambda (server) (start-server/exec server (const #t))) ;; Client (lambda () (call-with-connected-session/shell (lambda (session) (let* ((node (make-node session)) (data '()) (proc '(lambda (n) (1+ n))) (j1 (make-job 'map #f data proc)) (j2 (set-job-node j1 node))) (and (not (eq? j1 j2)) (eq? (job-type j1) (job-type j2)) (eq? (job-node j1) #f) (eq? (job-node j2) node) (eq? (job-data j1) (job-data j2)) (eq? (job-proc j1) (job-proc j2))))))))) (test-error-with-log "hand-out-job, invalid type" (run-client-test ;; server (lambda (server) (start-server/exec server (const #t))) ;; client (lambda () (call-with-connected-session/shell (lambda (session) (let ((n (make-node session))) (hand-out-job (make-job 'invalid-job n '() (const #t))))))))) (test-assert-with-log "assign-eval" (run-client-test ;; server (lambda (server) (start-server/exec server (const #t))) ;; client (lambda () (call-with-connected-session/shell (lambda (session) (let* ((nodes (make-list 2 (make-node session))) (exprs (make-list 10 '(lambda (x) (1+ x)))) (jobs (assign-eval nodes exprs))) (and (eq? (length jobs) 2) (eq? (job-type (car jobs)) 'eval) (eq? (length (job-proc (car jobs))) 5)))))))) ;;; Testing of 'rrepl-get-result'. ;; These test cases are intended to test various inputs for 'rrepl-get-result' ;; procedure. (test-assert "rrepl-get-result" (receive (result eval-num module-name lang) (call-with-input-string "scheme@(guile-user)> $0 = test" rrepl-get-result) (and (eq? result 'test) (= eval-num 0) (string=? module-name "(guile-user)") (string=? lang "scheme")))) (test-assert "rrepl-get-result, unspecified" (receive (result eval-num module-name lang) (call-with-input-string "scheme@(guile-user)> " rrepl-get-result) (and (eq? result *unspecified*) (eq? eval-num *unspecified*) (string=? module-name "(guile-user)") (string=? lang "scheme")))) (test-error-with-log/= "rrepl-get-result, error" 'node-repl-error "scheme@(guile-user)> ERROR: error." (call-with-input-string "scheme@(guile-user)> ERROR: error." rrepl-get-result)) ;; See . (test-error-with-log/= "rrepl-get-result, compilation error" 'node-repl-error "scheme@(guile-user)> While compiling expression:\nERROR: no code for module (module-that-doesnt-exist)" (call-with-input-string (string-append "scheme@(guile-user)> While compiling expression:\n" "ERROR: no code for module (module-that-doesnt-exist)") rrepl-get-result)) (test-error-with-log/= "rrepl-get-result, unbound variable error" 'node-repl-error "scheme@(guile-user)> ;;; socket:9:7: warning: \ possibly unbound variable `e'\nsocket:9:7: In procedure #:\nsocket:9:7: In procedure module-lookup: \ Unbound variable: e" (call-with-input-string (string-append (string-append "scheme@(guile-user)> ;;; socket:9:7: warning: " "possibly unbound variable `e'\nsocket:9:7: " "In procedure #:\n" "socket:9:7: In procedure module-lookup: Unbound variable: e")) rrepl-get-result)) ;; Here we have to use regexps to match the error message because of ;; differences between Guile 3.0.7 and older versions. ;; ;; See (test-error-with-log/match "rrepl-get-result, unknown # object error" 'node-repl-error "Reader error: .+: #:1:3: \ Unknown # object: \\(.+\\): scheme@\\(guile-user\\)> \ \\$4 = #@#:22 \\(disconnected\\) 453fff>" (call-with-input-string (string-append "scheme@(guile-user)> $4 = " "#@#:22 (disconnected) 453fff>") rrepl-get-result)) (test-assert "rrepl-get-result, elisp" (receive (result eval-num module-name lang) (call-with-input-string "elisp@(guile-user)> $0 = #nil" rrepl-get-result) (and (eq? result '#nil) (= eval-num 0) (string=? module-name "(guile-user)") (string=? lang "elisp")))) (test-assert "rrepl-get-result, multiple values" (receive (result eval-num module-name lang) (call-with-input-string "scheme@(guile-user)> $0 = v1\n$1 = v2" rrepl-get-result) (and (vector? eval-num) (vector? result) (eq? (vector-ref result 0) 'v1) (eq? (vector-ref result 1) 'v2) (= (vector-ref eval-num 0) 0) (= (vector-ref eval-num 1) 1) (string=? module-name "(guile-user)") (string=? lang "scheme")))) (test-assert "rrepl-skip-to-prompt, valid input" (begin (call-with-input-string "Enter `,help' for help." (lambda (port) (rrepl-skip-to-prompt port))) #t)) (test-error-with-log "rrepl-skip-to-prompt, invalid input" 'node-error (call-with-input-string "invalid input" (lambda (port) (rrepl-skip-to-prompt port)))) (test-assert-with-log "node-guile-version, valid response" (run-client-test ;; Server (lambda (server) (start-server/exec server (const #t))) ;; Client (lambda () (call-with-connected-session/shell (lambda (session) (format-log/scm 'nolog "client" "session: ~a" session) (let ((n (make-node session))) (string=? (node-guile-version n) "GNU Guile 2.2.3"))))))) ;;; Distributed forms. ;; The client uses distributed form 'with-ssh' to evaluate (+ 21 21). The ;; server pretends to be a RREPL server and returns the evaluation "result", ;; 42. (test-equal-with-log "with-ssh" 42 (run-client-test ;; server (lambda (server) (start-server/exec server (lambda (session message channel) (let ((line (read-line channel))) (format-log/scm 'nolog "with-ssh" "client request: ~A" line) (write-line "$1 = 42\n" channel))))) ;; client (lambda () (call-with-connected-session/shell (lambda (session) (format-log/scm 'nolog "client" "session: ~a" session) (let ((n (make-node session))) (with-ssh n (+ 21 21)))))))) ;;; (define exit-status (test-runner-fail-count (test-runner-current))) (test-end "dist") (exit (= 0 exit-status)) ;;; dist.scm ends here. guile-ssh-0.18.0/tests/key.scm000066400000000000000000000237101471416131000161370ustar00rootroot00000000000000;;; key.scm -- Testing of Guile-SSH keys ;; Copyright (C) 2014-2024 Artyom V. Poptsov ;; ;; This file is a part of Guile-SSH. ;; ;; Guile-SSH 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 3 of the ;; License, or (at your option) any later version. ;; ;; Guile-SSH 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 Guile-SSH. If not, see . (add-to-load-path (getenv "abs_top_srcdir")) (use-modules (srfi srfi-64) (ssh key) (ssh version) (tests common)) ;;; ;; ECDSA doesn't work if libssh 0.6.3 was compiled GCrypt (define %openssl? (eq? (get-crypto-library) 'openssl)) (define-syntax-rule (when-openssl test) (or (not %openssl?) test)) (define-syntax-rule (unless-openssl expr) (or %openssl? expr)) (define-syntax-rule (unless-dsa-supported expr) (unless (dsa-support?) expr)) (test-begin-with-log "key") (test-assert-with-log "public-key-from-file: RSA" (public-key-from-file %rsakey-pub)) (unless-dsa-supported (test-skip "public-key-from-file: DSA")) (test-assert-with-log "public-key-from-file: DSA" (public-key-from-file %dsakey-pub)) (unless-openssl (test-skip "public-key-from-file: ECDSA")) (test-assert-with-log "public-key-from-file: ECDSA" (public-key-from-file %ecdsakey-pub)) (test-assert "private-key-from-file: RSA" (private-key-from-file %rsakey)) (unless-dsa-supported (test-skip "private-key-from-file: DSA")) (test-assert "private-key-from-file: DSA" (private-key-from-file %dsakey)) (unless-openssl (test-skip "private-key-from-file: ECDSA")) (test-assert "private-key-from-file: ECDSA" (private-key-from-file %ecdsakey)) (define *rsa-pub-key* (public-key-from-file %rsakey-pub)) (define *dsa-pub-key* (and (dsa-support?) (public-key-from-file %dsakey-pub))) (define *ecdsa-pub-key* (when-openssl (public-key-from-file %ecdsakey-pub))) (test-equal "key?: not a key" #f (key? "not a key")) (test-assert "key?: RSA" (key? (private-key-from-file %rsakey))) (unless-dsa-supported (test-skip "key?: DSA")) (test-assert "key?: DSA" (key? (private-key-from-file %dsakey))) (unless-openssl (test-skip "key?: ECDSA")) (test-assert "key?: ECDSA" (key? (private-key-from-file %ecdsakey))) (test-assert "key?: RSA (public)" (key? *rsa-pub-key*)) (unless-dsa-supported (test-skip "key?: DSA (public)")) (test-assert "key?: DSA (public)" (key? *dsa-pub-key*)) (unless-openssl (test-skip "key?: ECDSA (public)")) (test-assert "key?: ECDSA (public)" (key? *ecdsa-pub-key*)) (test-assert "private-key?: RSA" (private-key? (private-key-from-file %rsakey))) (test-equal "private-key?: RSA (public)" #f (private-key? *rsa-pub-key*)) (test-equal "private-key?: not a key" #f (private-key? "not a key")) (test-assert "public-key?: RSA (public)" (public-key? *rsa-pub-key*)) (test-assert "public-key?: RSA" (public-key? (private-key-from-file %rsakey))) (test-equal "public-key?: not a key" #f (public-key? "not a key")) (test-assert-with-log "private-key->public-key: RSA" (private-key->public-key (private-key-from-file %rsakey))) (unless-dsa-supported (test-skip "private-key->public-key: DSA")) (test-assert-with-log "private-key->public-key: DSA" (private-key->public-key (private-key-from-file %dsakey))) (unless-openssl (test-skip "private-key->public-key: ECDSA")) (test-assert-with-log "private-key->public-key: ECDSA" (private-key->public-key (private-key-from-file %ecdsakey))) (test-assert-with-log "get-key-type: RSA" (equal? (eq? 'rsa (get-key-type (private-key-from-file %rsakey))))) (unless-dsa-supported (test-skip "get-key-type: DSA")) (test-assert-with-log "get-key-type: DSA" (equal? (eq? 'rsa (get-key-type (private-key-from-file %dsakey))))) (unless-openssl (test-skip "get-key-type: ECDSA")) (test-assert-with-log "get-key-type: ECDSA" (let ((key (private-key-from-file %ecdsakey))) (or (eq? 'ecdsa-p256 (get-key-type key)) ;; For libssh versions prior to 0.9 (eq? 'ecdsa (get-key-type key))))) (unless-openssl (test-skip "private-key-to-file")) (test-assert-with-log "private-key-to-file" (let ((file-name "./tmp-rsa-key")) (private-key-to-file (private-key-from-file %rsakey) file-name) (let ((key (private-key-from-file file-name))) (delete-file file-name) (and (key? key) (private-key? key))))) ;;; Converting between strings and keys (define %rsakey-pub-string "AAAAB3NzaC1yc2EAAAADAQABAAABAQC+8H9j5Yt3xeqaAxXAtSbBsW0JsJegngwfLveHA0ev3ndEKruylR6CZgf6OxshTwUeBaqn7jJMf+6RRQPTcxihgtZAfdyKdPGWDtmePBnG64+uGEaP8N3KvCzlANKf5tmxS8brJlQhxKL8t+3IE8w3QmCMnCGKWprsL/ygPA9koWauUqqKvOQbZXdUEfLvZfnsE1laRyK4dwLiiM2vyGZM/2yePLP4xYu/uYdPFaukxt3DMcgrEy9zuVcU8wbkJMKM57sambvituzMVVqRdeMX9exZv32qcXlpChl4XjFClQ0lqOb8S8CNTPXm3zQ2ZJrQtUHiD54RYhlXD7X0TO6v") (define %dsakey-pub-string "AAAAB3NzaC1kc3MAAACBAOpnJ64w3Qo3HkCCODTPpLqPUrDLg0bxWdoae2tsXFwhBthIlCV8N0hTzOj1Qrgnx/WiuDk5qXSKOHisyqVBv8sGLOUTBy0Fdz1SobZ9+WGu5+5EiJm78MZcgtHXHu1GPuImANifbSaDJpIGKItq0V5WhpLXyQC7o0Vt70sGQboVAAAAFQDeu+6APBWXtqq2Ch+nODn7VDSIhQAAAIA5iGHYbztSq8KnWj1J/6GTvsPp1JFqZ3hFX5wlGIV4XxBdeEZnCPrhYJumM7SRjYjWMpW5eqFNs5o3d+rJPFFwDo7yW10WC3Bfpo5xRxU35xf/aFAVbm3vi/HRQvv4cFrwTLvPHgNYGYdZiHXCXPoYIh+WoKT9n3MfrBXB4hpAmwAAAIEArkWuRnbjfPVFpXrWGw6kMPVdhOZr1ghdlG5bY31y4UKUlmHvXx5YZ776dSRSMJY2u4lS73+SFgwPdkmpgGma/rZdd9gly9T7SiSr/4qXJyS8Muh203xsAU3ukRocY8lsvllKEGiCJmrUTJWmj0UYEDsbqy2k/1Yz2Q/awygyk9c=") (define %ecdsakey-pub-string "AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBHcpje/fp21KjuZFKgmKAAwHeYJ6e3ny4LwEVjZr8hOCVlBvqj7/krVqxbwZI7EcowbpYI1F8ZszS7zfUhKT3U4=") (test-equal "public-key->string, RSA" (public-key->string *rsa-pub-key*) %rsakey-pub-string) (unless-dsa-supported (test-skip "public-key->string, DSA")) (test-equal "public-key->string, DSA" (public-key->string *dsa-pub-key*) %dsakey-pub-string) (when-openssl (test-equal "public-key->string, ECDSA" (public-key->string *ecdsa-pub-key*) %ecdsakey-pub-string)) (test-equal "string->public-key, RSA" (public-key->string (string->public-key %rsakey-pub-string 'rsa)) %rsakey-pub-string) (unless-dsa-supported (test-skip "string->public-key, DSA")) (test-equal "string->public-key, DSA" (public-key->string (string->public-key %dsakey-pub-string 'dss)) %dsakey-pub-string) (unless-openssl (test-skip "string->public-key, ECDSA")) (test-equal "string->public-key, ECDSA" (if (>= (string->number (cadr (string-split (get-libssh-version) #\.))) 9) (public-key->string (string->public-key %ecdsakey-pub-string 'ecdsa-p256)) (public-key->string (string->public-key %ecdsakey-pub-string 'ecdsa))) %ecdsakey-pub-string) (test-assert-with-log "string->public-key, RSA, gc test" (let ((max-keys 1000)) (do ((idx 1 (+ idx 1))) ((> idx max-keys)) (when (zero? (euclidean-remainder idx 100)) (format-log/scm 'nolog "" (format #f "~d / ~d keys created ..." idx max-keys))) (public-key->string (string->public-key %rsakey-pub-string 'rsa))) #t)) (test-assert-with-log "make-keypair: RSA" (let ((key (make-keypair 'rsa 1024))) (and (key? key) (eq? (get-key-type key) 'rsa)))) (unless-dsa-supported (test-skip "make-keypair: DSS")) (test-assert-with-log "make-keypair: DSS" (let ((key (make-keypair 'dss 1024))) (and (key? key) (eq? (get-key-type key) 'dss)))) (unless-openssl (test-skip "make-keypair: ECDSA")) (test-assert-with-log "make-keypair: ECDSA" (let ((key (make-keypair 'ecdsa 256))) (and (key? key) (or (eq? (get-key-type key) 'ecdsa) ; libssh < 0.9 (eq? (get-key-type key) 'ecdsa-p256))))) ;;; Check reading encrypted keys. (let* ((version (get-libssh-version)) (version (map string->number (string-split version #\.)))) (format-log/scm 'nolog "none" "***** version: ~a ~a ~a~%" (car version) (cadr version) (caddr version)) ;; XXX: libssh 0.8.0 version components: ;; LIBSSH_VERSION_MAJOR 0 ;; LIBSSH_VERSION_MINOR 7 ;; LIBSSH_VERSION_MICRO 90 (when (and (zero? (car version)) (or (= (cadr version) 7) (and (= (cadr version) 8) (< (caddr version) 3)))) ;; XXX: Those tests fails with ""Unsupported private key method ssh-rsa" ;; error as support for keys in openssh container format (other than ;; ed25519) was added only in 0.8.3. (test-skip "encrypted key: RSA") (test-skip "encrypted key: RSA: access denied"))) (test-assert-with-log "encrypted key: RSA" (private-key-from-file %rsakey-encrypted #:auth-callback (lambda (prompt max-len echo? verify? userdata) "123"))) (test-error-with-log "encrypted key: RSA: access denied" (private-key-from-file %rsakey-encrypted #:auth-callback (lambda (prompt max-len echo? verify? userdata) #f))) (unless-dsa-supported (test-skip "encrypted key: DSS")) (test-assert-with-log "encrypted key: DSS" (private-key-from-file %dsakey-encrypted #:auth-callback (lambda (prompt max-len echo? verify? userdata) "123"))) (unless-openssl (test-skip "encrypted key: ECDSA")) (test-assert-with-log "encrypted key: ECDSA" (private-key-from-file %ecdsakey-encrypted #:auth-callback (lambda (prompt max-len echo? verify? userdata) "123"))) ;;; (define exit-status (test-runner-fail-count (test-runner-current))) (test-end "key") (exit (= 0 exit-status)) ;;; key.scm ends here. guile-ssh-0.18.0/tests/keys/000077500000000000000000000000001471416131000156135ustar00rootroot00000000000000guile-ssh-0.18.0/tests/keys/dsakey000066400000000000000000000012401471416131000170130ustar00rootroot00000000000000-----BEGIN DSA PRIVATE KEY----- MIIBvAIBAAKBgQDqZyeuMN0KNx5Agjg0z6S6j1Kwy4NG8VnaGntrbFxcIQbYSJQl fDdIU8zo9UK4J8f1org5Oal0ijh4rMqlQb/LBizlEwctBXc9UqG2fflhrufuRIiZ u/DGXILR1x7tRj7iJgDYn20mgyaSBiiLatFeVoaS18kAu6NFbe9LBkG6FQIVAN67 7oA8FZe2qrYKH6c4OftUNIiFAoGAOYhh2G87UqvCp1o9Sf+hk77D6dSRamd4RV+c JRiFeF8QXXhGZwj64WCbpjO0kY2I1jKVuXqhTbOaN3fqyTxRcA6O8ltdFgtwX6aO cUcVN+cX/2hQFW5t74vx0UL7+HBa8Ey7zx4DWBmHWYh1wlz6GCIflqCk/Z9zH6wV weIaQJsCgYEArkWuRnbjfPVFpXrWGw6kMPVdhOZr1ghdlG5bY31y4UKUlmHvXx5Y Z776dSRSMJY2u4lS73+SFgwPdkmpgGma/rZdd9gly9T7SiSr/4qXJyS8Muh203xs AU3ukRocY8lsvllKEGiCJmrUTJWmj0UYEDsbqy2k/1Yz2Q/awygyk9cCFQDQQTY2 mHV9J3u9CQFwuQAGdZ2Gig== -----END DSA PRIVATE KEY----- guile-ssh-0.18.0/tests/keys/dsakey.pub000066400000000000000000000011151471416131000176010ustar00rootroot00000000000000ssh-dss AAAAB3NzaC1kc3MAAACBAOpnJ64w3Qo3HkCCODTPpLqPUrDLg0bxWdoae2tsXFwhBthIlCV8N0hTzOj1Qrgnx/WiuDk5qXSKOHisyqVBv8sGLOUTBy0Fdz1SobZ9+WGu5+5EiJm78MZcgtHXHu1GPuImANifbSaDJpIGKItq0V5WhpLXyQC7o0Vt70sGQboVAAAAFQDeu+6APBWXtqq2Ch+nODn7VDSIhQAAAIA5iGHYbztSq8KnWj1J/6GTvsPp1JFqZ3hFX5wlGIV4XxBdeEZnCPrhYJumM7SRjYjWMpW5eqFNs5o3d+rJPFFwDo7yW10WC3Bfpo5xRxU35xf/aFAVbm3vi/HRQvv4cFrwTLvPHgNYGYdZiHXCXPoYIh+WoKT9n3MfrBXB4hpAmwAAAIEArkWuRnbjfPVFpXrWGw6kMPVdhOZr1ghdlG5bY31y4UKUlmHvXx5YZ776dSRSMJY2u4lS73+SFgwPdkmpgGma/rZdd9gly9T7SiSr/4qXJyS8Muh203xsAU3ukRocY8lsvllKEGiCJmrUTJWmj0UYEDsbqy2k/1Yz2Q/awygyk9c= guile-ssh-0.18.0/tests/keys/ecdsakey000066400000000000000000000003431471416131000173260ustar00rootroot00000000000000-----BEGIN EC PRIVATE KEY----- MHcCAQEEICxjzq1R4GmvhXiIIeNrwMnzxp2sM22k9dzR6kAqwhS0oAoGCCqGSM49 AwEHoUQDQgAEdymN79+nbUqO5kUqCYoADAd5gnp7efLgvARWNmvyE4JWUG+qPv+S tWrFvBkjsRyjBulgjUXxmzNLvN9SEpPdTg== -----END EC PRIVATE KEY----- guile-ssh-0.18.0/tests/keys/ecdsakey.pub000066400000000000000000000002411471416131000201100ustar00rootroot00000000000000ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBHcpje/fp21KjuZFKgmKAAwHeYJ6e3ny4LwEVjZr8hOCVlBvqj7/krVqxbwZI7EcowbpYI1F8ZszS7zfUhKT3U4= guile-ssh-0.18.0/tests/keys/encrypted-dsa-key000066400000000000000000000026621471416131000210740ustar00rootroot00000000000000-----BEGIN OPENSSH PRIVATE KEY----- b3BlbnNzaC1rZXktdjEAAAAACmFlczI1Ni1jdHIAAAAGYmNyeXB0AAAAGAAAABAFO0WEoE w2vxZG4WIvWrTTAAAAEAAAAAEAAAGyAAAAB3NzaC1kc3MAAACBAOvV83NIMvJBcaQqZJ4a s7Vtkrfrn5eeWTCBZE/Hp85S/Z/qbva/7bdEMGzQXGl45i+fKY7piVE69coY9vC5hXGZiS KgRmjGnsgVO8FAsBasSqoOKDDHoTFjaTTRehWMWgMBjqYurXFN5PSqy+YKOtK/QJcUYC5W 4D2tgJ+inCqXAAAAFQCYRVJ2RmeoPvN6VMSJGKCapgp4jQAAAIBvfFMf9BGEFepn7ElxOx fhl3NdVju0/vIiiYTWNp4fsgLjOhfE0M/Em2W5c8TJDkqYmqsFZF+Z07J6dxf6ehq8AI7O Ior2g/yovlmCypVgb4PzoQGITAtOXROn+hVgXtbtimW8l+eQr9bf4QDJlzh050pLJ41My5 lj+x5YtlLMaAAAAIEAm/akPouQjtiyC43D8kCbOtHI9BC2lhysqSASFCyR73uh6dDIJAKq qXE0e/6PL6HSCQbrKZSjcvFT4neIVC7xAcvcaT5hNvE1+0MYGCXR1KMByZEeD2SrFa3yQo eL5WHeAO+6JsUUIjsxEp72hUMerj3mRC/LWXIUkJoiXPHLd3kAAAIANwz25cmNNxllu2kx Eot8dAsiCgbcFHxPl3E9dkNx9FrI+TfNhP9bm0J03JblOdnzptRHIZ4xFgshvdKpTzCHpL nQVbW8POmcuZ4yhYvNpJvJTXmkX2MDngjhBAlM3Pte5NiloxQ/V4XQSNfG1RqDFh0AsOH2 uHrtrrQGzTPB5NG1d7PWfnFO2C2R/DO6fDtg5hCbV0bZSDNmL2Bq1OS5Pwsh9WYUjl/y2M ZfSqyBGDsGi36S5eOOm1H42RE8n+r7RMYxi9W1i0vcVlPzGhg6e/sciTUwweL6SkIQDMEW 5TTnIY3odbXc2ojUg4+KZU/ZWiFSd2cTBXVIZEl+0/ZhO5Xf99oTsBwcOU5q1WfwgRJ2da spEEagzlR+mWU4tx7dnTkW4kE1pDWUNl6KD+F+OaxyaLF/oASqvjMR1XMntmgjeB80dsfc xw/k/Car1qp+wQyFzybLrJ7UTuWF5Hb3dcDIZ7bQ4kwX/O80mqgPGw2yo7dcTVfyDUOYO4 TkResvqKQe330IVx+/Q8T0hWTFPH+VeoZrtqnGa3uLQiWR0JZEiRSxKqA77uXG66ZDlqep HicbrpWlWfeS657nByfZsbk72BoawgDb2F9wP0PbwwkqKbmxjCJXDD1J4/5KaYwfjg3tfM JM6G1mZRcLucxpx6kFjQ9TY15b4DEY3tEqaU4= -----END OPENSSH PRIVATE KEY----- guile-ssh-0.18.0/tests/keys/encrypted-dsa-key.pub000066400000000000000000000011521471416131000216520ustar00rootroot00000000000000ssh-dss AAAAB3NzaC1kc3MAAACBAOvV83NIMvJBcaQqZJ4as7Vtkrfrn5eeWTCBZE/Hp85S/Z/qbva/7bdEMGzQXGl45i+fKY7piVE69coY9vC5hXGZiSKgRmjGnsgVO8FAsBasSqoOKDDHoTFjaTTRehWMWgMBjqYurXFN5PSqy+YKOtK/QJcUYC5W4D2tgJ+inCqXAAAAFQCYRVJ2RmeoPvN6VMSJGKCapgp4jQAAAIBvfFMf9BGEFepn7ElxOxfhl3NdVju0/vIiiYTWNp4fsgLjOhfE0M/Em2W5c8TJDkqYmqsFZF+Z07J6dxf6ehq8AI7OIor2g/yovlmCypVgb4PzoQGITAtOXROn+hVgXtbtimW8l+eQr9bf4QDJlzh050pLJ41My5lj+x5YtlLMaAAAAIEAm/akPouQjtiyC43D8kCbOtHI9BC2lhysqSASFCyR73uh6dDIJAKqqXE0e/6PL6HSCQbrKZSjcvFT4neIVC7xAcvcaT5hNvE1+0MYGCXR1KMByZEeD2SrFa3yQoeL5WHeAO+6JsUUIjsxEp72hUMerj3mRC/LWXIUkJoiXPHLd3k= Guile-SSH test encrypted key guile-ssh-0.18.0/tests/keys/encrypted-ecdsa-key000066400000000000000000000051631471416131000214030ustar00rootroot00000000000000-----BEGIN OPENSSH PRIVATE KEY----- b3BlbnNzaC1rZXktdjEAAAAACmFlczI1Ni1jdHIAAAAGYmNyeXB0AAAAGAAAABB7u4OpMC pubU/UmWnEW1sfAAAAEAAAAAEAAAGXAAAAB3NzaC1yc2EAAAADAQABAAABgQDQnyku6+HR RbCWPInAlUIeZBf+MYVpJKIw6UZ34Nb0QoYl1kDIxfFbIwd2u/CCivuYiBgla0d8X10i1Z 6vr3wvrps0yll7HOOuZT2CQPATW0KLqpTF+Rh61odsZ8zp4Nwyelm+7r3L3e79JLoiYOA+ 1v7dHemIU5jcIPFDN1xib5FG/ayYtwHYvEsoJ1i2b8EES2ec7Hz0MdaqED9p4rw4yRkVEt KxHt2K4bhZWGY/ufiTG96PwnsvqzD714Phtr2O7mOrwDZ8F/aDugTRDBQmfzVuqHKp13nE s5ss7rH0LANPxGLDFg/CyZX879t85nqLLjFp9u6joILUrP5lr5Ba74YykBKK9d+8SXB+Mr etVhfwPd4RTkpBwKxeyuH6Vd2om9x8ZC7nchnercx/hzczJQHvmlDfU03bK5WZLRgVKe9I A8SKnIpq2rZWU/uADSqu4vpg85lE4D6D1l1ebdjW2mdmCu1cezciGoTICEeJwndga20bMZ LHun4pjxTrE+cAAAWgza3yhv0yLi5RFS4uVG5jzzdcfWootBVWlgT8bF9vTcyPWGed9SZk j0HgwoTcvNpbhmFkzHO2xh5TplXJInHbUL8zpaQEBpt91ryFo6u+5RHu2MatBK6Pz6elzm LZB0UTvipUkc9di6xwxpJqorEn5ozhtJJfrZDW9zI4xEic6ymxlGR7sXACwx4/NVIcDdzw 1knDGPL5ddColqkuFyJwzfU4r0z23QbxTawgWyJibisIaBVnkCeCkdcqFjqc2ojWgJUG75 8d6bdSvGYS8mpsKFi1/jccgaiGHpb9ZxugTjMdS+9N9nPW46PXp2TPmL6Itp2FnbIVYbmJ JXa6ZsBi0XXAhxm5pBH3oPqa+CkUQCBktxMPy/rzTVw1NQP882gPFoCunswubONcHF8+V/ mOBFH1BoPo4XRxONm/U/qgZLstD6dCeyZFQkKEswXg3kYpbAg0OU1jOEnEuFMffKJRhHxG dJ+YiTJH8Fqehn/2SpAjwO1N35pOdaUj6xc0AGkApXTWjwjYHs5Fyx6Z9xf2PGeVRN47fu WzJqGraf2lRxGeH+qvspINmk6Ciw+GIHgJqdge4NuKGJStqCV/rQp2qfNtwbr58vYLWjFi 8Qeqr68OsJsSg08CMcYneBEc1J7b4F6dCmnkFrbM7Dvio0vLLTk9EoxFUG9e5yZod+vneW oLWyHKr+WPxCQB2Hm4tHDHZrsqRA69PjuwD8G3HTRR6gc+i43bBTi0l4m8JQ5NOh3ADkUM 1Rut+K3EnLO/QRK2Gt0NAlH1LkrUOnTQLzinAY/CIouvL44ZorJwMcQFhaULoKaoAlOQy4 VcC2gVNVcl/UemT8SezUAENIDPFoBnVTtI1v+fdJtRt6g1lrJXgD5z8ea9TjXuppa8eSKY 5p9mogm73r2yenViVnwwaL8PWg/GDOHsHh8zqA+dbw6OF7aryF4DEmyy8UCnS6GlgWHIs4 hHz31NqcScTBikdo91ne5dRLpmOxqQBzspe6z+ttKS7xsp/QMSQcdtoDGYyMShOnxA11xh YgmSErjI9U+X4GEPB11vAZnc13aRPpEGpG5r7ztQy45TxH4pFI3DRQZpvrQzAzh5H4fTm6 Cgp7x3UthOG7lnxKXlAp8p9wRdB29zCltZTRJaG0tE/9yEqVyjqc5pLNga+MQukbJeIJZX YztYWIbrJyaBc35E929oNFc+tFIGTvnGfWqIw0s0YPjdef9eMc194t+w5nzDXyf7mZJg+9 TQuSs05BTusVN8Oo1vhrj4OnMy4aR6feqFO/TR8mBvvaIgSDFTjXVc7C5WpRDGb/t8VXoL lGgB3DITRsARaqeV65epwP7Or2xlRDrAt/U1AN5296hT1v4SQOG6fI7nQU6bJpWMt1U5f9 law3U+q48XJvYl+lCJwHi/ZAkqmI/uvFQ/oNzWb/Ardz51PbSekGPpcd66HFP2fr/X7xhl 656rRphp3G3IOucjt8y4sDrgqo3QObmXW/eG6gY0dRDxk2nEPJqvWH2tB0E0sn9VoKRRuL 0UifzyFo4O5lxObio1IfrH+qtPkHFtAynmXAJZYDjKlPUUb6pJbpajMkaeYsBTHcoNUmts 8auZ2PGffJ/UtEH4Z4C9tQF3jas7ieHi0FjtONqBv7M02pErSsWT8FY+RgMQFOOQ2CJgGT 4wrRxhMMrNTCI39LIeU6jTxeAmcqr/bRmrGobexIHXcSdrH8u3AqdUKQBePVoO0QdWtFa6 wtjO67U60UJrqHEGAdVjKLhYktkdOxBKj7b64UsQKOpTQIxrAmK4buaXe1iOvmPl357NDi OxRnJEe8uC5KvkafIuADjwWv4ZqP9R21OVcrTSnRor1t1YZ8/fDAMMjy2Os+docH+mn7dW UtCGm1klxld/bsBqU4CGYa0MqpzLFYWVsCZAoVgcAHkP/RK1 -----END OPENSSH PRIVATE KEY----- guile-ssh-0.18.0/tests/keys/encrypted-ecdsa-key.pub000066400000000000000000000011061471416131000221610ustar00rootroot00000000000000ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABgQDQnyku6+HRRbCWPInAlUIeZBf+MYVpJKIw6UZ34Nb0QoYl1kDIxfFbIwd2u/CCivuYiBgla0d8X10i1Z6vr3wvrps0yll7HOOuZT2CQPATW0KLqpTF+Rh61odsZ8zp4Nwyelm+7r3L3e79JLoiYOA+1v7dHemIU5jcIPFDN1xib5FG/ayYtwHYvEsoJ1i2b8EES2ec7Hz0MdaqED9p4rw4yRkVEtKxHt2K4bhZWGY/ufiTG96PwnsvqzD714Phtr2O7mOrwDZ8F/aDugTRDBQmfzVuqHKp13nEs5ss7rH0LANPxGLDFg/CyZX879t85nqLLjFp9u6joILUrP5lr5Ba74YykBKK9d+8SXB+MretVhfwPd4RTkpBwKxeyuH6Vd2om9x8ZC7nchnercx/hzczJQHvmlDfU03bK5WZLRgVKe9IA8SKnIpq2rZWU/uADSqu4vpg85lE4D6D1l1ebdjW2mdmCu1cezciGoTICEeJwndga20bMZLHun4pjxTrE+c= Guile-SSH test encrypted key guile-ssh-0.18.0/tests/keys/encrypted-rsa-key000066400000000000000000000051631471416131000211110ustar00rootroot00000000000000-----BEGIN OPENSSH PRIVATE KEY----- b3BlbnNzaC1rZXktdjEAAAAACmFlczI1Ni1jdHIAAAAGYmNyeXB0AAAAGAAAABBnAPOYxr 7c+OI5fzG/8CRuAAAAEAAAAAEAAAGXAAAAB3NzaC1yc2EAAAADAQABAAABgQDLxXl65L77 UGN9xqqCgDi4wb7JMgKrsLA5uNp8FnWN6DRS0DXaymBuxU7pblUAqY752vC6oqJ/EMIfDB M66JJZKwN5IwuHoz7gOyd+FLbAi8wRRVXBnw4Muk+SOyDa/bdOpKLI8iqC//4KCQMA4BGP hb1+R6kSIqNmy5HfPCCYTKN9/Neuvx8bj7OvCLairYlALweU3A4l4LMKN0ujqbWihMKCBL QhaW/Z/6GLN31unocSgvOgDtM5aWB0TWfRTsjKIq6cdzjigt9F3lztiUHm1RRncqn0L+7J /wqiXWFpwbfw2wOELkiBYp1zGTiWzc1bs/DJuhIPK1Ylfini7M9UndXgPMNLOmqgE6UX2K +TlH0YES0Rxqq22AF8JMOg4CtxyBBw2+mk7itwZdWHIKPqL/RyUTu6eqAvkqzij58DXSx+ ec8PO6o2hYqf5NVmmUOB4q5nL/rfJxSqdKo0CKXVFIBBacCXHIkdZXFTmM2C92TP1WFCf7 GCTLQZLFgP4kUAAAWgS8Fu3ewxUn+7d5Fkoo3KGufgCyTgYjwlpRmbMcwdLxZ2E87WD/Jq fPX9U377ZqNrBC5PdX0PVSHQFV4HcXPJUsnUshvtP2M72C02X0wvejr7FZCT9KkMJs2pcq G+oxc+6j3NgJXm36u+O7pvuM8e1KNE4yQE6vmBbVqKxO25qnh0rsCzKD6iCw7Jy11jitqf 7RHGvO+t27KmVzmRP7anLDnAdCjtOJBBLIxxalgvTtZ0flWYm0MB1ukuvYjESk8tHkuEjG UAanuN7bQe2iqffhQAKbFJv9SKPL48XVyiJBnJuxp3t5w0Hrugt/bhIfd2LGR9xM/8+AM5 9FYjieB/uac691k+O+k9Ec0gHsxNhSHEUUho/jbbgqKEB5UFESDm35bxCDAoPwFe4GfBUU bUpfYqwb3QwzcYnf7MEbacoYK8jQF1SyDqmGsYJOYBjTXlvQlVlpRK6LtLyJ/q8b4jErJq 8j6Wg5s1bPaC1vswJDfjfgdpRi5NukBLBQKSESKdHEWBWErssFdRHWrYxAMvggb3feD5py oAnFg/MyAdL30MAJbkMUuh29jDTQwp/EMCgkUlFbXViAN/UiV2uoJ/A/28eXGE1VnYdvc0 6q4InR/suJXZLkoPpNLjuV14JXvEW7BQWhQ75BQR0FB83QeY3U1E7VTf+QGQqS3MU3hMAH 0RolDNpFKv0DAm6kS0aYMamdqqf49zPGFUhNHKTXmybJGj5vC7M1pSLnws4xzLeKzLSNnM HI1Vb+crVvFBtXrXYctQh+q761GkQ63vcRu3t62CMdm8RssPwXMfiTBZZm2kJvozLksUmw CEJr98inUZ092xbfDHE2gsvbp5ELHG8Zah+bss6zsF7w9v+BoQRf9sJJljrumUXyiJdIWu vUWwww28lh/biJGPW/VhqyHLPZVaxH5c2tnrfku8/aMOkwMwm6bsyljA8hkmG6pRUGKs9W 47J6ytZ5lLRteIlT8imYDm13Zl2PxKlK6msE12qDarXAzaLp71gTQOuw+NPBF8jDQYWrq5 3mx4X7xSxyczsZf9DtlAyH/09l1hL4eYmaElYJI9Z+daK9C3mOlQ+bLeNB/ZXaH8KdiVBg yGN79VcmokWVS9yde4himqQLeH8wkNO3HlyvFAYY8sORlKo5T01wGAx2sX4JeHNSCggcQ1 QT9GCwvFhebNoqEqDq2TcwgGkmhory1hDaivjcZ/CCBRHaOKWw/C0eAtvvXQo6FSisKR/r +NnKWM/8OVc8b/WpHAOJAY+9c2BpGMlDWt06Wg0vxGebDtxaZxxmif3S29fuDtr4vaNCl7 4cEj4xEoGNxmCt6FKEZcaq2pUVoSSVMaNdBHaYQZ/2h+KoyLMtXBxb+2ubrldbfe3Kq9xF Vm3qRXilJIzN3XawprL38LZZOKlPBOMVVN629fwydfc8N932yYCGyVmmkL2156WcZxMl1m yt+tyu6/MdrU7RJpTpOaQSZHrjDMuhrXJymODV7FCuM2hCgmb4eqpnl/U5llLDgZL/lYIO SJPhzkTB6PaRtOZtbv+NX2xBLcP39xv7nkbFl7fwQwWjE7b4jzJpJJPsb8pFoyYbEmQyDj wwjzrLZP3Rls77Nep+2jRg5fhtCj5v/suru8WyNp9D4WiDDE7GlHwiAabvjbVhlG164gvt kBHYwUZEXDdRSMqvFlmJN96OCphX2YGlspTWm8GS33lGOzdvSo5695xb9blRhx3gz/nA21 jQzhnMAHJaXfm6iqo9fhSOysu8PhLi69bM3ZZZMV/D2tCFS8B5sh2gIJKzfY21oUjoo9i9 odJdEPSuscIV8mbd69Pbs3JhrVAV1eZB1z8N+xKMDkQbZYYYyt0x7ciBmqGQQ9eZrIGwZj G+SfZAiZpsNW+UHyCysx6NW2vmXHvWncxw61OPTPIAVPxCDX -----END OPENSSH PRIVATE KEY----- guile-ssh-0.18.0/tests/keys/encrypted-rsa-key.pub000066400000000000000000000011061471416131000216670ustar00rootroot00000000000000ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABgQDLxXl65L77UGN9xqqCgDi4wb7JMgKrsLA5uNp8FnWN6DRS0DXaymBuxU7pblUAqY752vC6oqJ/EMIfDBM66JJZKwN5IwuHoz7gOyd+FLbAi8wRRVXBnw4Muk+SOyDa/bdOpKLI8iqC//4KCQMA4BGPhb1+R6kSIqNmy5HfPCCYTKN9/Neuvx8bj7OvCLairYlALweU3A4l4LMKN0ujqbWihMKCBLQhaW/Z/6GLN31unocSgvOgDtM5aWB0TWfRTsjKIq6cdzjigt9F3lztiUHm1RRncqn0L+7J/wqiXWFpwbfw2wOELkiBYp1zGTiWzc1bs/DJuhIPK1Ylfini7M9UndXgPMNLOmqgE6UX2K+TlH0YES0Rxqq22AF8JMOg4CtxyBBw2+mk7itwZdWHIKPqL/RyUTu6eqAvkqzij58DXSx+ec8PO6o2hYqf5NVmmUOB4q5nL/rfJxSqdKo0CKXVFIBBacCXHIkdZXFTmM2C92TP1WFCf7GCTLQZLFgP4kU= Guile-SSH test encrypted key guile-ssh-0.18.0/tests/keys/rsakey000066400000000000000000000032131471416131000170330ustar00rootroot00000000000000-----BEGIN RSA PRIVATE KEY----- MIIEowIBAAKCAQEAvvB/Y+WLd8XqmgMVwLUmwbFtCbCXoJ4MHy73hwNHr953RCq7 spUegmYH+jsbIU8FHgWqp+4yTH/ukUUD03MYoYLWQH3cinTxlg7ZnjwZxuuPrhhG j/Ddyrws5QDSn+bZsUvG6yZUIcSi/LftyBPMN0JgjJwhilqa7C/8oDwPZKFmrlKq irzkG2V3VBHy72X57BNZWkciuHcC4ojNr8hmTP9snjyz+MWLv7mHTxWrpMbdwzHI KxMvc7lXFPMG5CTCjOe7Gpm74rbszFVakXXjF/XsWb99qnF5aQoZeF4xQpUNJajm /EvAjUz15t80NmSa0LVB4g+eEWIZVw+19EzurwIDAQABAoIBAQC0xAEGtUGFohUJ u9PzPk0z4OKm4s2aHSbCuvdSldNfd9EX8xEB79UThL8WsrBrp2Dj3F+FXqe17wQP +fO2UufFuJVYNw/88NvqwaJbAPEydr7vBkJ/cXy4u9AQ+edtxOLhzCjFZOMPmRbp BMSTv9J9mlTHqeTDFCZJZuDXXiUAkX2ahgomEYsvOn4cAfTHzOV4mmtFmJwaIJg/ NcDxVb/ojsc7j1mGRvkVxsPqLwkSoVq2rwpXc23NyExmmq/YJzej9JmZ2xfARWzo 0V/k1kYU4ALDadSiVljvhJOrEyvKaObtBYWze4mUsUA4vP141asw40W8mxzinudp SYxByB55AoGBAOwYxKzywepcH/gVMaKt3dmmK230CkMa06qHPaeclFtzwRR9PYpP gPPvuLcavCFZmOM9K6mdizs5XxXc/KL1KTRpfWqXpiEtP8d9icGYgsE7q/wh2cui iwdBHaweGqwZwHaOX06jlNLXrFfeQ5gjO2NPnXfiNKPAZH90PIYkY5n7AoGBAM8J LyesuBdqD9c17kKoVmGl6CroQxjIedCl3hfB3jQKrLy8nsYmpd3yq7cNaI7UXlvu TWFKG8KP3DH/gFvs8KN6PQ7NcLDfVv/AaKCiNiOzOeKruqs+KniE09GWff/BCX66 ++6NRFTr3nZ9XqWHQChQZDJSmosnXSj2vuFarDPdAoGAL9K4i/vEUc+FXkAUxMoJ JRwmsef76CnX9DPexkPOPVQOKTNRMuH10fOd6+ELeInokScD4CCcYku1uf0AY5Xb WdWAZQYAzbmXsLX6IG/fFHsc1D6bGkd7d+W1t/aFGpVAygL+xTQXYjnzm/zWnkuM rQokcHMujHjdIoAN/nICht8CgYBiZUAHABxh7GNo6dW50l1zfTERK1+wKJ9UXXBn JBlh7GzaKl7fV8De8hVQI0w9DYtm76PRCDKXTl3dWUv85Ggdmdvo7BSRyyOC20Qe i9llMCnjo7BM8Heo3Z/57Scm5OyJUX6oinUeUxdggwb3boc8YbCtBfszBVtOO67O VZSf9QKBgEkm1/jk2U1KMX85JMies70CGWE/8/ev6zxSlDY3pr7+bloySUoAXF9t Bhjb+bmL7UVEI2USOMAwknybmUQ2IAiKdCgFIZ2v0E3XIzN71zcm2qnBciJedLtu moOKkxJJ5dwVnPAKNY+BM36pEBCIyejtjNXDcYuktAS2ks3LyrNB -----END RSA PRIVATE KEY----- guile-ssh-0.18.0/tests/keys/rsakey.pub000066400000000000000000000006121471416131000176200ustar00rootroot00000000000000ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC+8H9j5Yt3xeqaAxXAtSbBsW0JsJegngwfLveHA0ev3ndEKruylR6CZgf6OxshTwUeBaqn7jJMf+6RRQPTcxihgtZAfdyKdPGWDtmePBnG64+uGEaP8N3KvCzlANKf5tmxS8brJlQhxKL8t+3IE8w3QmCMnCGKWprsL/ygPA9koWauUqqKvOQbZXdUEfLvZfnsE1laRyK4dwLiiM2vyGZM/2yePLP4xYu/uYdPFaukxt3DMcgrEy9zuVcU8wbkJMKM57sambvituzMVVqRdeMX9exZv32qcXlpChl4XjFClQ0lqOb8S8CNTPXm3zQ2ZJrQtUHiD54RYhlXD7X0TO6v avp@elephant guile-ssh-0.18.0/tests/log.scm000066400000000000000000000037171471416131000161350ustar00rootroot00000000000000;;; log.scm -- Testing of the logging callback ;; Copyright (C) 2014 Artyom V. Poptsov ;; ;; This file is a part of Guile-SSH. ;; ;; Guile-SSH 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 3 of the ;; License, or (at your option) any later version. ;; ;; Guile-SSH 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 Guile-SSH. If not, see . (use-modules (srfi srfi-64) (ssh log)) (test-begin "log") (test-equal "current-logging-callback" %default-log-printer (current-logging-callback)) (define (custom-logging-callback priority function message useradata) (display "Hello Scheme World!")) (test-equal "set-logging-callback!, custom" custom-logging-callback (begin (set-logging-callback! custom-logging-callback) (current-logging-callback))) (test-equal "set-logging-callback!, default (libssh)" %default-libssh-log-printer (begin (set-logging-callback! %default-libssh-log-printer) (current-logging-callback))) (test-equal "set-logging-callback!, default" %default-log-printer (begin (set-logging-callback! %default-log-printer) (current-logging-callback))) (test-assert "set-log-verbosity!" (begin (set-log-verbosity! 'functions) (catch #t (lambda () (set-log-verbosity! 'wrong-verbosity) #f) (lambda (key . args) #t)))) (test-equal "get-log-verbosity" 'functions (get-log-verbosity)) (define exit-status (test-runner-fail-count (test-runner-current))) (test-end "log") (exit (= 0 exit-status)) ;;; log.scm ends here guile-ssh-0.18.0/tests/manual/000077500000000000000000000000001471416131000161155ustar00rootroot00000000000000guile-ssh-0.18.0/tests/manual/channel-leak.scm000077500000000000000000000021711471416131000211470ustar00rootroot00000000000000;;; channel-leak.scm -- Check if libssh channels are not freed corretly. ;; ;; This test checks if the channel are properly freed; otherwise the OpenSSH ;; server will report "no more sessions" error when the maximum number of ;; sessions per a TCP connection (as specified by "MaxSessions" option) is ;; exhausted. ;; ;; Reported by Andrew Tropin in ;; ;; ;; The test for reproducing the problem was provided by Ludovic Courtès ;; . This file contains its code with slight changes. (use-modules (ssh session) (ssh popen) (ssh auth) (ssh log) (rnrs io ports)) (define session (make-session #:host "localhost")) (define (main args) (session-parse-config! session) (connect! session) (userauth-public-key/auto! session) (set-log-verbosity! 'functions) (let loop ((i 0)) (format (current-error-port) "-- ~a --~%" i) (let ((pipe (open-remote-pipe session "date" "r"))) (pk 'x (get-string-all pipe)) (close-port pipe) (loop (+ 1 i))))) ;;; channel-leak.scm ends here. guile-ssh-0.18.0/tests/popen.scm000066400000000000000000000111221471416131000164620ustar00rootroot00000000000000;;; popen.scm -- Remote pipes testing. ;; Copyright (C) 2015, 2016 Artyom V. Poptsov ;; ;; This file is a part of Guile-SSH. ;; ;; Guile-SSH 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 3 of the ;; License, or (at your option) any later version. ;; ;; Guile-SSH 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 Guile-SSH. If not, see . (add-to-load-path (getenv "abs_top_srcdir")) (use-modules (srfi srfi-64) (ice-9 rdelim) (tests common) (ssh channel) (ssh session) (ssh auth) (ssh log) (ssh popen)) (set-log-verbosity! 'functions) (test-begin-with-log "popen") ;;; Helper procedures. (define (call-with-connected-session/popen proc) "Make a session for a channel test." (call-with-connected-session (lambda (session) (authenticate-server session) (userauth-none! session) (proc session)))) (define (response=? channel string) "Read a line from a CHANNEL, check if the line is equal to a STRING." (string=? (read-line channel) string)) (define (input-only? port) (and (input-port? port) (not (output-port? port)))) (define (output-only? port) (and (output-port? port) (not (input-port? port)))) ;;; (test-assert-with-log "open-remote-pipe, OPEN_READ" (run-client-test (lambda (server) (start-server/exec server (lambda () #t))) (lambda () (sleep 1) (call-with-connected-session/shell (lambda (session) (let ((channel (open-remote-pipe session "ping" OPEN_READ))) (and (input-only? channel) (poll channel (lambda args (response=? channel "pong")))))))))) (test-assert-with-log "open-remote-pipe, OPEN_PTY_READ" (run-client-test (lambda (server) (start-server/exec server (const #t))) (lambda () (call-with-connected-session/shell (lambda (session) (let* ((OPEN_PTY_READ (string-append OPEN_PTY OPEN_READ)) (channel (open-remote-pipe session "ping" OPEN_PTY_READ))) (format-log/scm 'nolog "open-remote-pipe, OPEN_PTY_READ" "channel: ~A" channel) (and (input-only? channel) (poll channel (lambda args (response=? channel "pong")))))))))) (test-assert-with-log "open-remote-pipe, OPEN_BOTH" (run-client-test (lambda (server) (start-server/exec server (const #t))) (lambda () (call-with-connected-session/shell (lambda (session) (let ((channel (open-remote-pipe session "ping" OPEN_BOTH))) (format-log/scm 'nolog "open-remote-pipe, OPEN_BOTH" "channel: ~A" channel) (and (input-port? channel) (output-port? channel) (poll channel (lambda args (response=? channel "pong")))))))))) (test-assert-with-log "open-remote-pipe*" (run-client-test (lambda (server) (start-server/exec server (const #t))) (lambda () (call-with-connected-session/shell (lambda (session) (let ((channel (open-remote-pipe* session OPEN_READ "ping"))) (format-log/scm 'nolog "open-remote-pipe*" "channel: ~A" channel) (and (input-only? channel) (poll channel (lambda args (response=? channel "pong")))))))))) (test-assert-with-log "open-remote-input-pipe" (run-client-test (lambda (server) (start-server/exec server (const #t))) (lambda () (call-with-connected-session/shell (lambda (session) (let ((channel (open-remote-input-pipe session "ping"))) (format-log/scm 'nolog "open-remote-input-pipe" "channel: ~A" channel) (and (input-only? channel) (poll channel (lambda args (response=? channel "pong")))))))))) (test-assert-with-log "open-remote-output-pipe" (run-client-test (lambda (server) (start-server/exec server (const #t))) (lambda () (call-with-connected-session/shell (lambda (session) (let ((channel (open-remote-output-pipe session "ping"))) (format-log/scm 'nolog "open-remote-output-pipe" "channel: ~A" channel) (output-only? channel))))))) (define exit-status (test-runner-fail-count (test-runner-current))) (test-end "popen") (exit (= 0 exit-status)) ;;; popen.scm ends here. guile-ssh-0.18.0/tests/server-client.scm000066400000000000000000000102771471416131000201350ustar00rootroot00000000000000;;; client-server.scm -- Guile-SSH server is SUT. ;; Copyright (C) 2014, 2015, 2016, 2017, 2018, 2019 Artyom V. Poptsov ;; ;; This file is a part of Guile-SSH. ;; ;; Guile-SSH 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 3 of the ;; License, or (at your option) any later version. ;; ;; Guile-SSH 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 Guile-SSH. If not, see . (add-to-load-path (getenv "abs_top_srcdir")) (use-modules (srfi srfi-64) (ice-9 threads) (ssh server) (ssh session) (ssh auth) (ssh message) (ssh log) (tests common)) (set-log-verbosity! 'functions) (test-begin-with-log "server-client") ;;; Helper procedures and macros (define clnmsg (let ((log (test-runner-aux-value (test-runner-current)))) (lambda (message) "Print a server MESSAGE to the test log." (format log " client: ~a~%" message)))) ;;; Testing of basic procedures (test-assert-with-log "accept, key exchange" (run-server-test ;; client (lambda (session) (sleep 1) (connect! session) (authenticate-server session)) ;; server (lambda (server) (server-listen server) (let ((s (server-accept server))) (catch #t (lambda () (server-handle-key-exchange s)) (lambda (key . args) (display args) (newline))) s)))) (test-assert-with-log "server-message-get" (run-server-test ;; client (lambda (session) (sleep 1) (connect! session) (clnmsg "connected") (authenticate-server session) (clnmsg "server authenticated") (userauth-none! session) (clnmsg "client authenticated")) ;; server (lambda (server) (server-listen server) (let ((session (server-accept server))) (server-handle-key-exchange session) (let ((msg (server-message-get session))) (message-auth-set-methods! msg '(none)) (message-reply-success msg) (message? msg)))))) (test-assert-with-log "message-get-type" (run-server-test ;; client (lambda (session) (usleep 100) (connect! session) (while (not (connected? session)) (usleep 100) (connect! session)) (clnmsg "connected") (authenticate-server session) (clnmsg "server authenticated") (userauth-none! session) (clnmsg "client authenticated") (while #t (sleep 5))) ;; server (lambda (server) (server-listen server) (let ((session (server-accept server))) (format-log/scm 'nolog "server" "session: ~a" session) (server-handle-key-exchange session) (let ((msg (server-message-get session))) (let ((msg-type (message-get-type msg)) (expected-type '(request-service))) (message-auth-set-methods! msg '(none)) (message-reply-success msg) (disconnect! session) (equal? msg-type expected-type))))))) (test-assert-with-log "message-get-session" (run-server-test ;; client (lambda (session) (sleep 1) (connect! session) (usleep 100) (authenticate-server session) (usleep 100) (userauth-none! session) (while #t (sleep 5))) ;; server (lambda (server) (server-listen server) (let ((session (server-accept server))) (server-handle-key-exchange session) (let* ((msg (server-message-get session)) (x (message-get-session msg))) (message-auth-set-methods! msg '(none)) (message-reply-success msg) (disconnect! x) (equal? x session)))))) (define exit-status (test-runner-fail-count (test-runner-current))) (test-end "server-client") (exit (= 0 exit-status)) ;;; server-client.scm ends here. guile-ssh-0.18.0/tests/server.scm000066400000000000000000000142741471416131000166620ustar00rootroot00000000000000;;; server.scm -- Testing of server procedures without a client. ;; Copyright (C) 2014, 2015, 2016, 2024 Artyom V. Poptsov ;; ;; This file is a part of Guile-SSH. ;; ;; Guile-SSH 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 3 of the ;; License, or (at your option) any later version. ;; ;; Guile-SSH 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 Guile-SSH. If not, see . (add-to-load-path (getenv "abs_top_srcdir")) (use-modules (srfi srfi-64) (ssh server) (ssh version) (ssh key) ;; Helper procedures (tests common)) (define %libssh-minor-version (string->number (cadr (string-split (get-libssh-version) #\.)))) (test-begin-with-log "server") ;;; (test-assert "%make-server" (%make-server)) (test-assert-with-log "server?" (let ((server (%make-server)) (x "I'm not a server")) (and (server? server) (not (server? x))))) (test-assert-with-log "comparison of servers" (let ((s1 (%make-server)) (s2 (%make-server))) (and (equal? s1 s1) (not (equal? s1 s2))))) (test-assert-with-log "server-set!, valid values" (let* ((server (%make-server)) (topdir (getenv "abs_top_srcdir")) (options `((bindaddr "127.0.0.1") (bindport 22) ,(if (>= %libssh-minor-version 7) (if (dsa-support?) (list 'hostkey %rsakey %dsakey) (list 'hostkey %rsakey)) '(hostkey "ssh-rsa" "ssh-dss")) (rsakey ,%rsakey) (dsakey ,%dsakey) (banner "string") (log-verbosity nolog rare protocol packet functions) (blocking-mode #f #t))) (options (if (dsa-support?) options (delete `(dsakey ,%dsakey) options))) (log (test-runner-aux-value (test-runner-current))) (res #t)) (format (current-error-port) "~a, options: ~a~%" (dsa-support?) options) (for-each (lambda (opt) (for-each (lambda (val) (catch #t (lambda () (server-set! server (car opt) val)) (lambda (key . args) (set! res #f) (format log " opt: ~a, val: ~a, error: ~a~%" (car opt) val args)))) (cdr opt))) options) res)) (test-assert-with-log "server-set!, invalid values" (let ((server (%make-server)) (options '(;; Errors with wrong IP address format will be ;; caught on `server-listen' call, so that's the ;; reason that we don't check `bindaddr' with ;; garbage strings here. (bindaddr #f 42) ;; The same situation with rsa/dsa keys -- errors ;; will be caught on `server-accept' call. (rsakey #f 42) (dsakey #f 42) (bindport "I'm not a port" -42) (hostkey "invalid value" 1 'invalid-value) (banner 12345) (log-verbosity -1 0 1 2 3 4 5) (blocking-mode 42 "string"))) (log (test-runner-aux-value (test-runner-current))) (res #t)) (for-each (lambda (opt) (for-each (lambda (val) (catch #t (lambda () (server-set! server (car opt) val) (format log " opt: ~a, val: ~a -- passed mistakenly~%" (car opt) val) (set! res #f)) (lambda (key . args) #t))) (cdr opt))) options) res)) (test-assert-with-log "make-server" (let ((topdir (getenv "abs_top_srcdir"))) (make-server #:bindaddr "127.0.0.1" #:bindport 123456 #:rsakey %rsakey #:dsakey (and (dsa-support?) %dsakey) #:banner "banner" #:log-verbosity 'nolog #:blocking-mode #f))) (test-assert-with-log "server-get" (let* ((topdir (getenv "abs_top_srcdir")) (bindaddr "127.0.0.1") (bindport 123456) (banner "banner") (log-verbosity 'nolog) (blocking-mode #f) (server (make-server #:bindaddr bindaddr #:bindport bindport #:rsakey %rsakey #:dsakey (and (dsa-support?) %dsakey) #:banner banner #:log-verbosity log-verbosity #:blocking-mode blocking-mode))) (and (eq? (server-get server 'bindaddr) bindaddr) (eq? (server-get server 'bindport) bindport) (eq? (server-get server 'rsakey) %rsakey) (if (dsa-support?) (eq? (server-get server 'dsakey) %dsakey) #t) (eq? (server-get server 'banner) banner) (eq? (server-get server 'log-verbosity) log-verbosity) (eq? (server-get server 'blocking-mode) blocking-mode)))) (test-assert-with-log "server-listen" (let* ((topdir (getenv "abs_top_srcdir")) (server (make-server #:bindaddr "127.0.0.1" #:bindport (get-unused-port) #:rsakey %rsakey #:log-verbosity 'nolog))) (server-listen server) #t)) (define exit-status (test-runner-fail-count (test-runner-current))) (test-end "server") (exit (= 0 exit-status)) ;;; server.scm ends here. guile-ssh-0.18.0/tests/session.scm000066400000000000000000000223631471416131000170350ustar00rootroot00000000000000;;; session.scm -- Testing of session procedures without a connection. ;; Copyright (C) 2014-2024 Artyom V. Poptsov ;; ;; This file is a part of Guile-SSH. ;; ;; Guile-SSH 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 3 of the ;; License, or (at your option) any later version. ;; ;; Guile-SSH 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 Guile-SSH. If not, see . (add-to-load-path (getenv "abs_top_srcdir")) (use-modules (srfi srfi-64) (ice-9 regex) (ssh session) (ssh log) (ssh version) ;; Helper procedures (tests common)) (define %libssh-minor-version (string->number (cadr (string-split (get-libssh-version) #\.)))) (set-log-verbosity! 'functions) (test-begin-with-log "session") ;;; (test-assert "%make-session" (%make-session)) (test-assert-with-log "%make-session, gc test" (let ((max-sessions 1000)) (do ((idx 1 (+ idx 1))) ((> idx max-sessions)) (when (zero? (euclidean-remainder idx 100)) (format-log/scm 'nolog "" (format #f "~d / ~d sessions created ..." idx max-sessions))) (%make-session)) #t)) (test-assert "session?" (let ((session (%make-session)) (x "string")) (and (session? session) (not (session? x))))) (test-assert "display, undefined values" (let* ((session (%make-session)) (output (with-output-to-string (lambda () (display session))))) (if (string-match "#@#:22 \\(disconnected\\) [0-9a-z]+>" output) output (error "Wrong output" output)))) (test-assert "display, defined values" (let* ((session (make-session #:host "example.org" #:user "alice")) (output (with-output-to-string (lambda () (display session))))) (if (string-match "#" output) output (error "Wrong output" output)))) (test-assert "comparison of sessions" (let ((s1 (%make-session)) (s2 (%make-session))) (and (equal? s1 s1) (not (equal? s1 s2))))) (test-assert "session-set!, valid values" (let ((session (%make-session)) (options `((host "localhost") (port 22) (bindaddr "127.0.0.1") (user "Random J. User") (timeout 15) ;seconds (timeout-usec 15000) ;milliseconds (ssh1 #f #t) (ssh2 #f #t) (log-verbosity nolog rare protocol packet functions nolog) (compression-level 1 2 3 4 5 6 7 8 9) (compression "yes" "no") (callbacks ((user-data . "hello") (global-request-callback . ,(const #f)))))) (res #t)) (if (>= %libssh-minor-version 8) (set! options (cons '(nodelay #f #t) options))) (for-each (lambda (opt) (for-each (lambda (val) (session-set! session (car opt) val)) (cdr opt))) options) res)) (unless (>= %libssh-minor-version 10) (test-skip "session-set!, rsa-min-size")) (test-assert "session-set!, rsa-min-size" (let ((session (%make-session))) (session-set! session 'rsa-min-size 1024))) (test-assert "session-set!, invalid values" (let ((session (%make-session)) (options '((host 12345 #t) (port "string" -22) (bindaddr 12345 -12345) (user 12345 -12345) (timeout "string" -15) (timeout-usec "string" -15000) (ssh1 12345 "string") (ssh2 12345 "string") (log-verbosity "string" -1 0 1 2 3 4 5) (compression 12345) (compression-level -1 0 10) (callbacks "not a list" ((global-request-callback . #f))))) (res #t)) (if (>= %libssh-minor-version 8) (set! options (cons '(nodelay 12345 "string") options))) (for-each (lambda (opt) (for-each (lambda (val) (catch #t (lambda () (session-set! session (car opt) val) (let* ((r (test-runner-current)) (l (test-runner-aux-value r))) (format l " opt: ~a, val: ~a -- passed mistakenly~%" (car opt) val) (set! res #f))) (const #t))) (cdr opt))) options) res)) (test-error "session-set!, invalid option type" 'wrong-type-arg (let ((session (%make-session))) (session-set! session "non-valid type" "value"))) (test-assert "session-get" (let* ((host "example.com") (port 12345) (user "alice") (proxycommand "test") (callbacks '((user-data . "test"))) (session (make-session #:host host #:port port #:user user #:identity %rsakey #:proxycommand proxycommand #:callbacks callbacks))) (and (string=? (session-get session 'host) host) (= (session-get session 'port) port) (string=? (session-get session 'user) user) (string=? (session-get session 'identity) %rsakey) (string=? (session-get session 'proxycommand) proxycommand) (equal? (session-get session 'callbacks) callbacks) ;; Make sure that default callbacks value is '#f'. (equal? (session-get (%make-session) 'callbacks) #f)))) (test-error "session-get, non-session object" 'wrong-type-arg (session-get "non-session object" 'test)) (test-error "session-get, invalid option" 'guile-ssh-error (let ((session (%make-session))) (session-get session 'wrong-option))) (test-assert "session-parse-config!" (let ((session (make-session #:host "example"))) (session-parse-config! session %config) (format (current-error-port) "session: ~a~%" session) (format (current-error-port) "host: ~a~%" (session-get session 'host)) (format (current-error-port) "user: ~a~%" (session-get session 'user)) (format (current-error-port) "port: ~a~%" (session-get session 'port)) (and (string=? (session-get session 'host) "example.org") (string=? (session-get session 'user) "alice") (= (session-get session 'port) 2222)))) (test-error "session-parse-config!, non-session object" 'wrong-type-arg (session-parse-config! "non-session object" "wrong-value")) (test-error "session-parse-config!, wrong config file" 'guile-ssh-error (session-parse-config! (%make-session) "wrong-value")) (test-assert "make-session" (make-session #:host "localhost" #:port 22 #:user "Random J. User")) (test-assert "make-session, '#:config' and '#:host' is specified" (make-session #:host "localhost" #:config %config)) (test-assert "make-session, '#:config' set to '/dev/null'" (make-session #:host "localhost" #:config "/dev/null")) ;; Setting '#:config' option to #f must set "process-config?" option to #f. (test-assert "make-session, '#:config' as a boolean value: #f" (make-session #:host "localhost" #:config #f)) ;; Setting '#:config' option to #t must initiate parsing the default user ;; configuration file ('~/.ssh/config'.) (test-assert "make-session, '#:config' as a boolean value: #t" (make-session #:host "localhost" #:config #t)) (test-error "make-session, only '#:config' is specified" 'guile-ssh-error (make-session #:config %config)) (test-equal "make-session: keywords must overwrite config options" 22 (let ((s (make-session #:host "example" #:port 22 ;; Configuration sets port to 2222 #:config %config))) (session-get s 'port))) (test-equal-with-log "blocking-flush!" 'ok (blocking-flush! (%make-session) 15)) (test-error "connected?, non-session object" 'wrong-type-arg (connected? "non-session object")) (test-assert "connected?, check that we are not connected" (let ((session (%make-session))) (not (connected? session)))) (define exit-status (test-runner-fail-count (test-runner-current))) (test-end "session") (exit (= 0 exit-status)) ;;; session.scm ends here. guile-ssh-0.18.0/tests/shell.scm000066400000000000000000000067571471416131000164720ustar00rootroot00000000000000;;; shell.scm -- Remote shell tests. ;; Copyright (C) 2016, 2017 Artyom V. Poptsov ;; ;; This file is a part of Guile-SSH. ;; ;; Guile-SSH 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 3 of the ;; License, or (at your option) any later version. ;; ;; Guile-SSH 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 Guile-SSH. If not, see . (add-to-load-path (getenv "abs_top_srcdir")) (use-modules (srfi srfi-64) (ice-9 rdelim) (ice-9 receive) (srfi srfi-4) (ssh session) (ssh channel) (ssh auth) (ssh key) (ssh log) (ssh shell) (ssh popen) (ssh message) (tests common)) (set-log-verbosity! 'functions) (test-begin-with-log "shell") ;;; ;; Client executes "uname", server replies with success code 0. (test-assert-with-log "rexec" (run-client-test ;; Server (lambda (server) (start-server/exec server (const #t))) ;; Client (lambda () (call-with-connected-session/shell (lambda (session) (format-log/scm 'nolog "rexec" "session: ~a" session) (receive (result exit-code) (rexec session "ping") (list result exit-code))))))) (test-assert-with-log "which" (run-client-test (lambda (server) (start-server/exec server (const #t))) (lambda () (call-with-connected-session/shell (lambda (session) (receive (result exit-code) (which session "uname") (and (zero? exit-code) (string=? (car result) "which 'uname'")))))))) (test-assert-with-log "pgrep" (run-client-test (lambda (server) (start-server/exec server (const #t))) (lambda () (call-with-connected-session/shell (lambda (session) (receive (result exit-code) (pgrep session "process-1") (and (zero? exit-code) (not (null? result)) (car result)))))))) (test-equal-with-log "pgrep, guile" '(12345) (run-client-test (lambda (server) (start-server/exec server (lambda (session message channel) (write-line "$1 = (12345)\n" channel)))) (lambda () (call-with-connected-session/shell (lambda (session) (receive (result exit-code) (pgrep session "process-2" #:use-guile? #t) result)))))) (test-assert-with-log "command-available?" (run-client-test (lambda (server) (start-server/exec server (const #t))) (lambda () (call-with-connected-session/shell (lambda (session) (command-available? session "guile")))))) (test-assert-with-log "loadavg" (run-client-test (lambda (server) (start-server/exec server (const #t))) (lambda () (call-with-connected-session/shell (lambda (session) (equal? (loadavg session) '("0.01" "0.05" "0.10" "4/1927" "242011"))))))) ;;; (define exit-status (test-runner-fail-count (test-runner-current))) (test-end "shell") (exit (= 0 exit-status)) ;;; shell.scm ends here. guile-ssh-0.18.0/tests/sssh-ssshd.scm000066400000000000000000000104711471416131000174510ustar00rootroot00000000000000;;; sssh-ssshd.scm -- Communication between sssh and ssshd. ;; Copyright (C) 2014, 2015, 2024 Artyom V. Poptsov ;; ;; This file is a part of Guile-SSH. ;; ;; Guile-SSH 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 3 of the ;; License, or (at your option) any later version. ;; ;; Guile-SSH 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 Guile-SSH. If not, see . (add-to-load-path (getenv "abs_top_srcdir")) (use-modules (srfi srfi-64) (ice-9 popen) (ice-9 rdelim) (ice-9 regex) ;; Helper procedures (tests common) (ssh version)) (test-begin-with-log "sssh-ssshd") ;;; (define *test-cmd* "uname -a") (define *srv-address* INADDR_LOOPBACK) (define *srv-port* 12600) (define *srv-pid-file* "ssshd.pid") (define *ssshd-cmd* (string-append %topbuilddir "/examples/ssshd.scm --detach" " --pid-file=" *srv-pid-file* " --port=" (number->string *srv-port*) " --rsakey=" %rsakey " --dsakey=" %dsakey)) (define %libssh-version (map string->number (string-split (get-libssh-version) #\.))) (define *sssh-cmd* (string-append %topbuilddir "/examples/sssh.scm" ;; XXX: We cannot use ECDSA keys in libssh versions prior 0.8.3 because of ;; the bug that was fixed only in 0.8.3. " --identity-file=" (if (or (= (cadr %libssh-version) 7) (and (= (cadr %libssh-version) 8) (< (caddr %libssh-version) 3))) %dsakey %ecdsakey) " --port=" (number->string *srv-port*) " --known-hosts-file=''" " " (inet-ntop AF_INET *srv-address*) " '" *test-cmd* "'")) (setenv "GUILE_LOAD_PATH" (string-append %topdir "/modules")) ;; We must unset `SSH_AUTH_SOCK' to prevent sssh from asking SSH agent ;; (if it is present) for keys. (unsetenv "SSH_AUTH_SOCK") (define ssshd-pid #f) (define (cleanup pid) (when pid (catch #t (lambda () (kill pid SIGTERM)) (const #t)) (catch #t (lambda () (waitpid pid)) (const #t))) (and (file-exists? *srv-pid-file*) (delete-file *srv-pid-file*))) (define (wait-pid-file max-tries pid-file) (let loop ((exists? #f) (sleep-time 1) ; s (try 1)) (if exists? (let* ((p (open-input-file pid-file)) (pid (read-line p))) (string->number pid)) (if (<= try max-tries) (begin (sleep sleep-time) (loop (file-exists? pid-file) (1+ sleep-time) (1+ try))) (begin (format #t "Couldn't read a PID file ~a in ~a tries.~%" pid-file try) #f))))) ;;; Tests (test-assert-with-log "ssshd, start" (let ((max-tries 10)) (system *ssshd-cmd*) (let ((pid (wait-pid-file max-tries *srv-pid-file*))) (cleanup pid) pid))) (test-assert-with-log "sssh, exec" (let ((max-tries 10)) (format (current-error-port) "test command: ~A~%" *test-cmd*) (format (current-error-port) "ssshd command: ~A~%" *ssshd-cmd*) (format (current-error-port) "sssh command: ~A~%" *sssh-cmd*) (system *ssshd-cmd*) (let* ((pid (wait-pid-file max-tries *srv-pid-file*)) (output (read-line (open-input-pipe *test-cmd*))) (p (open-input-pipe *sssh-cmd*)) (result (let ((line (read-line p))) (format (current-error-port) " line: ~a~%" line) (and (not (eof-object? line)) (string=? line output))))) (format (current-error-port) "output: ~a~%" output) (format (current-error-port) "result: ~a~%" result) (cleanup pid) result))) (define exit-status (test-runner-fail-count (test-runner-current))) (test-end "sssh-ssshd") (exit (= 0 exit-status)) ;;; sssh-ssshd.scm ends here. guile-ssh-0.18.0/tests/tunnel.scm000066400000000000000000000153741471416131000166630ustar00rootroot00000000000000;;; tunnel.scm -- Guile-SSH tunnel tests. ;; Copyright (C) 2015, 2016 Artyom V. Poptsov ;; ;; This file is a part of Guile-SSH. ;; ;; Guile-SSH 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 3 of the ;; License, or (at your option) any later version. ;; ;; Guile-SSH 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 Guile-SSH. If not, see . (add-to-load-path (getenv "abs_top_srcdir")) (use-modules (srfi srfi-64) (srfi srfi-26) (ice-9 rdelim) (ice-9 receive) ;; Helper procedures. (tests common) ;; Guile-SSH (ssh auth) (ssh channel) (ssh log) (ssh session) (ssh server) (ssh tunnel)) (test-begin-with-log "tunnel") ;;; (define %test-string "hello scheme world") (define (call-with-connected-session/tunnel proc) (call-with-connected-session (lambda (session) (authenticate-server session) (userauth-none! session) (proc session)))) (define (call-with-forward-channel session proc) (let ((channel (make-channel session))) (dynamic-wind (const #f) (lambda () (case (channel-open-forward channel #:source-host "localhost" #:local-port (get-unused-port) #:remote-host "localhost" #:remote-port (1+ (get-unused-port))) ((ok) (proc channel)) (else => (cut error "Could not open forward" <>)))) (lambda () (close channel))))) (test-equal-with-log "port forwarding, direct" %test-string (run-client-test ;; server (lambda (server) (start-server/dt-test server (lambda (channel) (write-line (read-line channel) channel)))) ;; client (lambda () (call-with-connected-session/tunnel (lambda (session) (call-with-forward-channel session (lambda (channel) (write-line %test-string channel) (poll channel read-line)))))))) (test-error-with-log "port forwarding, direct, disconnected session" (run-client-test ;; server (lambda (server) (start-server/dt-test server (lambda (channel) (write-line (read-line channel) channel)))) ;; client (lambda () (call-with-connected-session/tunnel (lambda (session) (disconnect! session) (call-with-forward-channel session (const #f))))))) ;; Create a tunnel, check the result. (test-assert-with-log "make-tunnel" (run-client-test ;; server (lambda (server) (start-server/dt-test server (lambda (channel) (write-line (read-line channel) channel)))) (lambda () (call-with-connected-session/tunnel (lambda (session) (let* ((local-port (get-unused-port)) (remote-host "www.example.org") (tunnel (make-tunnel session #:port local-port #:host remote-host))) (and (eq? (tunnel-session tunnel) session) (string=? (tunnel-bind-address tunnel) "127.0.0.1") (eq? (tunnel-port tunnel) local-port) (eq? (tunnel-host-port tunnel) local-port) (eq? (tunnel-host tunnel) remote-host) (eq? (tunnel-reverse? tunnel) #f)))))))) ;; Client calls 'call-with-ssh-forward' with a procedure which sends a string ;; to a server; server echoes the string back. Client checks if the sent ;; string and the result of 'call-with-ssh-forward' matches. ;; ;; Note that the main part of the test is done in "call/pf" process, only ;; comparison of the original string and the call result is done in the main ;; process of the test case. The reason for this is srfi-64 tests go bananas ;; when a thread is spawn in a test: the thread shares memory with the parent, ;; and it inherits the test environment, which in turn leads to errors. ;; ;; XXX: This test case contains operations that potentially can block it ;; forever. ;; ;; Here's a schematic representation of the test case: ;; ;; test ;; | ;; o Fork. ;; |____________________ ;; | \ ;; | call/pf | server ;; | | ;; o | 'call-with-ssh-forward' ;; | | ;; o "hello world" | Sending a message to the server. ;; |------------------->| ;; | o Echoing back. ;; |<-------------------| ;; (test-equal-with-log "call-with-ssh-forward" %test-string (run-client-test ;; Server (lambda (server) (start-server/exec server (lambda (channel) (write-line (read-line channel) channel)))) ;; Client (call/pf) (lambda () (call-with-connected-session/tunnel (lambda (session) (let* ((local-port (get-unused-port)) (remote-host "www.example.org") (tunnel (make-tunnel session #:port local-port #:host remote-host))) (let ((result (call-with-ssh-forward tunnel (lambda (channel) (write-line %test-string channel) (poll channel read-line))))) (disconnect! session) result))))))) (test-assert-with-log "channel-{listen,cancel}-forward" (run-client-test ;; Server (lambda (server) (start-server/exec server (const #t))) ;; Client (lambda () (call-with-connected-session/tunnel (lambda (session) (let ((portnum (get-unused-port))) (and (receive (result pnum) (channel-listen-forward session #:address "localhost" #:port portnum) (and (equal? result 'ok) (= pnum portnum))) (eq? (channel-cancel-forward session "localhost" portnum) 'ok)))))))) (define exit-status (test-runner-fail-count (test-runner-current))) (test-end "tunnel") (exit (= 0 exit-status)) ;;; tunnel.scm ends here. guile-ssh-0.18.0/tests/version.scm000066400000000000000000000026631471416131000170400ustar00rootroot00000000000000;;; key.scm -- Testing of Guile-SSH keys ;; Copyright (C) 2022 Artyom V. Poptsov ;; ;; This file is a part of Guile-SSH. ;; ;; Guile-SSH 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 3 of the ;; License, or (at your option) any later version. ;; ;; Guile-SSH 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 Guile-SSH. If not, see . (add-to-load-path (getenv "abs_top_srcdir")) (use-modules (srfi srfi-64) (ssh version) (tests common)) (define %test-suite-name "version") (test-begin-with-log %test-suite-name) (test-assert "get-libssh-version" (get-libssh-version)) (test-assert "get-library-version" (get-library-version)) (test-assert "get-crypto-library" (get-crypto-library)) (test-assert "zlib-support?" (object->string (zlib-support?))) (test-assert "dsa-support?" (object->string (dsa-support?))) (define exit-status (test-runner-fail-count (test-runner-current))) (test-end %test-suite-name) (exit exit-status) ;;; version.scm ends here.