- cl-net-snmp-cvs@lists.common-lisp.net - mailman3.common-lisp.net

[cl-net-snmp-cvs] r24 - in books: . onlisp
by ctian＠common-lisp.net 28 Aug '07

28 Aug '07

Author: ctian Date: Mon Aug 27 22:13:01 2007 New Revision: 24 Added: books/ books/onlisp/ books/onlisp/0-preface.tex books/onlisp/1-the_extensible_language.tex books/onlisp/2-functions.tex books/onlisp/24-prolog.tex books/onlisp/3-functional_programming.tex books/onlisp/notes.tex books/onlisp/onlisp.kilepr books/onlisp/onlisp.tex books/onlisp/packages.tex Log: Add onlisp translate (zh_CN) Added: books/onlisp/0-preface.tex ============================================================================== --- (empty file) +++ books/onlisp/0-preface.tex Mon Aug 27 22:13:01 2007 @@ -0,0 +1,186 @@ +\chapter*{前言} +\label{chap:preface} + +本书适用于那些想成为更好的 Lisp 程序员的人. 本书假设读者已经熟悉 Lisp, 但不要求已有广泛的编程经验. +最初几章里会包含一些知识回顾. 我希望这些章节也令有经验的 Lisp 程序员感兴趣, 因为它们以新的视角展示了熟知的主题. + +通常很难用一句话来表达一门编程语言的本质, 但 John Foderato 这句已经很接近了: + +\begin{quote} + Lisp 是一门可编程的编程语言. +\end{quote} + +当然 Lisp 的特性绝不至这些, 但这种随心所欲使用 Lisp 的能力, 在很大程度上正是 Lisp 专家和新手的区别之处. +其他程序员根据语言向下写程序, 而资深 Lisp 程序员用程序向上构造语言\footnote{译者注: + 翻译可能不太准确, 原文是 + ``As well as writing their programs down toward the language, + experienced Lisp programmers build the language + up toward their programs.''}. + +本书教授如何使用自底向上的编程风格, 因为这是 Lisp 最擅长的方式. + +\section*{自底向上的设计} +\label{sec:bottom-up_design} + +随着软件复杂度的增长, 自底向上设计的重要性也正在日益提高. 今天的程序可能不得不面对极其复杂甚至开放式的需求. +在这种情况下,传统的自顶向下方法有时会失效. 一种新的编程风格由此诞生, 它和当前大部分计算机科学课程的思路截然不同: +一个自底向上的程序由一系列的层写成, 每一层都作为更上一层的编程语言. X Window 和 \TeX +就是这种程序设计风格的范例. + +本书的主题是双重的: 就是说 Lisp 对于以自底向上的风格编写程序来说是一种自然的语言, +同时自底向上的风格也是编写 Lisp 程序的一种自然的方式. \textsl{论 Lisp} 因此将吸引两类读者. +对于那些有兴趣编写可扩展程序的人, 本书将告诉你如果有了正确的语言你能做什么. 对于 Lisp 程序员来说, +本书提供一套关于怎样使用 Lisp 才能发挥其最大优势的实践性说明. + +本书的标题是为了强调自底向下编程对于 Lisp 的重要性. 相比只是用 Lisp 编写你的程序, 你还可以 \textsl{用 Lisp} +写你自己的语言, 然后再用来写你的程序. + +理论上用任何语言都可以写出的自底向上风格的程序, 但 Lisp 对于这种编程风格来说是最自然的载体. 在 Lisp 里, +自底向上设计不是一种专用于少见的大型或困难的程序的特别技术. 任何程度的程序都可以部分地用这种方式编写. +Lisp 从一开始就是种可扩展的语言. 这种语言本身基本上就是一个 Lisp 函数的集合, 这些函数和你自己定义的没有本质区别. +更进一步的是, Lisp 函数可以表达成列表, 这也是 Lisp 的数据结构. 这就意味着你可以写能生成 Lisp 代码的 Lisp 函数. + +一个好的 Lisp 程序员必须懂得如何利用上述这种可能性的优势. 通常做到这点的方式是定义一种称为 \textsl{宏} +的操作符. 驾驭宏是从编写正确的 Lisp 程序到编写漂亮的程序过程中最重要的一步. 入门级 Lisp +书籍给宏留下的篇幅仅限于一个宏的简短的概述: 一个关于宏是什么的解释, 连带少许暗示你能用这种奇妙的东西做什么的示例. +不过在本书里这些奇妙的东西将得到特别的重视. +本书的一个目标就是将所有那些人们至今都很难学到的使用宏的经验收集到一处. + +一般入门级 Lisp 书籍都不太强调 Lisp 和其他语言的区别, 当然这是可以理解的. +它们不得不从那些大都被学校教导成只会用 Pascal 术语来思考程序的学生中获得信息. +如果仔细解释这些区别的话只会加重混乱程度: 例如说 \texttt{defun} 虽然看起来像一个过程定义, +但实际上是一个程序在写另一个程序然后生成一段代码生成了一个函数对象然后用函数定义时给出的第一个参数来索引它. + +本书的一个目的就是解释究竟什么使 Lisp 不同于其他语言. 当我刚开始的时候, 我知道, 当所有其他条件都相等时, +我更倾向于用 Lisp 而不是 C 或 Pascal 或 Fortran 来写程序. 我也知道这不只是感觉的问题. +但我意识到如果我真的准备要解释 Lisp 在某些场合下是更好的语言, 我就最好得准备解释下为什么了. + +当某些人问 Louis Armstrong 什么是爵士乐时, 他回答说 ``如果你问爵士乐是什么, 那你永远不会知道.'' +但他确实以一种方式回答了这个问题: 他向人们 \textsl{展示} 了什么是爵士乐. 同样也只有一种方式来解释 Lisp +的威力---演示那些对于其他语言来说极其困难甚至不可能实现的技术. 多数关于编程的书籍---包括 Lisp 编程书籍--- +采用的都是那些你可以用任何语言编写的程序. \textsl{On Lisp} 处理的是那类你只能用 Lisp 来写的程序. +可扩展性, 自顶向下编程, 交互式开发, 源代码转换, 嵌入式语言---这些都是 Lisp 展示其高级特性的场合. + +当然, 从理论上讲, 任何图灵等价的编程语言都可以做到任何其他同类语言相同的事. 但那种程度的能力不是编程语言所关心的. +理论上任何你能用编程语言做到的事也可以用图灵机来说, 但实际上在一个图灵机上编程得不偿失. + +所以当我说这本书是关于讲如何做那些其他语言不可能做到事情的时候, 我并非指数学意义上的 ``不可能'', +而是在事实上从编程语言角度去看的. 这就是说, 如果你不得不用 C 来写本书中的一些程序, 你可能需要先用 C +写一个 Lisp 编译器. 举个例子, C 语言中的嵌入式 Prolog---你能想象这需要多少工作量吗? +第 24 章将说明如何用 180 行 Lisp 做到这点. + +我希望做到比简单地演示 Lisp 的威力更多的事, 尽管如此, 我也想解释 \textsl{为何} Lisp 与众不同. +这将出现一个本质问题---过于本质而不得不使用诸如 ``符号计算'' 这样的术语来回答. +我将尽我所能地试图尽可能清晰地解释这些问题. + +\section*{本书计划} +\label{sec:plan_of_the_book} + +由于函数是 Lisp 编程的基础, 本书以一些有关函数的章节开始. +第 2 章解释 Lisp 函数究竟是什么以及他们所提供的可能性. +第 3 章然后讨论函数型编程的优点, 这是 Lisp 程序最突出的风格. +第 4 章展示如何用函数来扩展 Lisp. +第 5 章建议了一种新类型的抽象让我们可以定义那些返回其他函数的函数. +最后, 第 6 章显示了怎样使用函数来代替传统的数据结构. + +相比函数, 本书更加关注宏. 宏得到更多的关注部分是因为宏本身就有更多内容, +部分是因为它们至今还没有适当的书面描述. 第 7--10 章形成一个宏技术的完整指导. +结束的时候你将了解一个有经验的 Lisp 程序员所知的关于宏的大多数内容: 它们如何工作; 怎样定义, 测试, 以及调试它们; +什么时候使用以及不使用宏; 宏的主要类型; 怎样写生成宏展开代码的程序; 宏风格一般如何区别于 Lisp 风格; +以及怎样检测和修复每一种影响宏的唯一性问题. + +紧跟着这些指导, 第 11--18 章展示了一些可以用宏构造出来的强有力的抽象. 第 11 章展示如何写经典宏--- +那些创造上下文, 或者实现循环或条件判断的宏. 第 12 章解释宏在生成变量操作中的角色. 第 13 +章展示宏如何通过将计算转移到编译期来使程序运行得更快. 第 14 章介绍了 anaphoric(首语重复) 宏, +可以允许你在程序里使用代词. 第 15 章展示了宏如何为第 5 章里定义的函数生成器提供一个更便利的接口. +第 16 章展示了如何使用可以定义宏的宏来让 Lisp 为你写程序. 第 17 章讨论读取宏, 以及第 18 章, 解构宏. + +第 19 章开始了本书的第四部分, 转向嵌入式语言. 第 19 章通过展示同一个程序, 一个回答数据库查询的程序, +先是用解释器, 然后用真正的嵌入式语言, 来介绍这一主题.第 20 章展示了如何将 continuation 概念引入 +Common Lisp 程序, 这是一种描述针对计算的提示的那种对象. Continuation 是一个强有力的工具, +可以用来实现多处理和非确定性选择. 将这些控制结构嵌入到 Lisp 中的讨论分别在第 21 和 22 章. +非确定性允许你写出有先见之明的程序, 听起来就像一种不寻常力量的抽象. 第 23 和 24 章展示了两种嵌入式语言, +让非确定性达到其存在的意义: 总共 200 行代码的一个完整的 ATN 解析器, 以及一个嵌入式 Prolog. + +这些程序相对短小的事实对它们本身来说并无意义. 如果你诉诸于编写无法理解的代码, 无人能告诉你 200 行代码能做干什么. +关键在于, 这些程序并不短, 因为它们依赖于编程技巧, 只是由于它们恰好用 Lisp 写成. 第 23 和 24 +章的关键之处不是如何用一页代码实现 ATN 解析器或者用两页实现 Prolog, 而是想说明这些程序, +当给出它们最自然的 Lisp 实现的时候是如此的简短. 后面这两个章节的嵌入式语言用实例证明了我开始时的观点: +Lisp 对于以自底向上的风格编写程序来说是一种自然的语言, 同时自底向上的风格也是编写 Lisp 程序的一种自然的方式. + +本书以一个关于面向对象编程的讨论结束, 尤其是 \textsc{CLOS}, Common Lisp 对象系统. 通过将这一主题留到最后, +我们可以更加清楚地看到, 面向对象的编程方式是一种 Lisp 已经展示过的扩展思想. 它也是可以 \textsl{在 Lisp 上} +构造出来的多种抽象之一. + +一个章节的有价值的注释开始于第 \pageref{chap:notes} 页. 这些注释里包括参考文献, 附加或者替换的代码, +或者是 Lisp 方面跟内容无关的一些描述. 注释是用页面边界外的小圆圈标注出来的, 就像这样\footnote{ + 目前还做不出来, 不会...}. 另外还有一个关于包 (packages) 的附录, 在第 \pageref{chap:packages} 页. + +正如一次纽约的观光旅游可能是一次世界上大多数文化的观光那样, 一次对 Lisp +作为可扩展编程语言的学习也能勾画出大部分 Lisp 技术. 这里描述的大多数技术通常都被 Lisp 社区所了解, +但很多内容至今也没有在任何地方有记载. 而一些问题, 例如宏的适当角色或者变量捕捉的本质, 甚至对于很有经验的 +Lisp 程序员来说也只有些模糊的理解. + +\section*{示例} +\label{sec:examples} + +Lisp 是个语言家族. 由于 Common Lisp 仍然是广泛使用的方言, 本书的大部分示例都是用 Common Lisp 写的. +这一语言最初于 1984 年被定义在 Guy Steele 写的的一本出版物 \textsl{Common Lisp: the Language} +(\textsc{CLTL1}) 里. 这一定义在 1990 年该书第二版 (\textsc{CLTL2}) 的出版以后被代替了, +\textsc{CLTL2} 可能会成为未来的 \textsc{ANSI} 标准. + +本书包含几百个示例, 范围从简单的表达式到可运行的 Prolog 实现. 本书中任何位置的代码, 都被写成可以在任何版本的 +Common Lisp 上运行\footnote{译者注: 翻译版中的将重新确保所有代码都可以在当前的 Common Lisp 标准下运行, +并且在 SBCL, LispWorks 等主要平台下测试, 所有这些代码修改也会通过脚注明确标示出来.}. +那些极少数需要用到不在 \textsc{CLTL1} 规范中实现的特性的示例将会被明显地在文本中标记出来. + +所有代码可以通过匿名 \textsc{FTP} 从 \texttt{endor.harvard.edu} 下载, 在 \texttt{pub/onlisp} +目录里. 问题和评论可以发到 \texttt{onlisp(a)das.harvard.edu}. + +\section*{致谢} +\label{sec:acknowledgements} + +写此书时, 我要特别感谢 Robert Morris 的帮助. 我经常去向他寻求建议并且每次都满载而归. +本书的一些示例代码就源自他, 包括某页的 \texttt{for} 版本, 某页的 \texttt{aand} 版本, 某页的 +\texttt{match}, 某页的宽度优先 \texttt{true-choose}, 以及第 24.2 章的 Prolog 解释器. +事实上, 整本书都 (有时基本是抄录) 反映了过去七年来我跟 Robert 之间的对话. (谢谢你, rtm!) + +我也要给予 David Moon 特别的感谢, 他仔细地阅读了大部分手稿并且给出许多非常有用的评论. 第 12 +章是按照他的建议完全重写了的, 某页关于变量捕捉的示例代码也是他提供的. + +我很幸运地拥有 David Touretzky 和 Skoma Brittain 这两位技术审稿人. 某些章节在他们的建议下被追加或者重写的. +某些上给出的替代的真非确定性选择操作符就是基于了 David Touretzky 的一个建议. + +其他一些人欣然阅读了部分或全部的手稿, 包括 Tom Cheatham, Richard Draves (他在 1985 年也帮助重写了 +\texttt{alambda} 和 \texttt{propmacro}), John Foderaro, David Hendler, George Luger, Robert +Muller, Mark Nitzberg, 以及 Guy Steele. + +我感谢 Cheatham 教授以及整个哈佛, 他们提供了让我撰写此书的条件. 也感谢 Aiken 实验室的全体成员, 包括 +Tony Hartman, Janusz Juda, Harry Bochner, 以及 Joanne Klys. + +Prentice Hall 的人做得很不错. 我为与 Alan Apt 这位优秀的编辑和好伙伴一起共事感到幸运. 同时也感谢 +Mona Pompili, Shirley Michaels, 以及 Shirley McGuire 的组织工作和他们的幽默. + +剑桥 Bow and Arrow 出版社的无与伦比的 Gino Lee 制作了封面. 封面上的那颗树暗示了某页上的观点. + +本书使用 \LaTeX 排版, 这是一种由 Leslie Lamport 在 Donald Knuth 的 \TeX 基础上设计的语言, +使用了来自 L. A. Carr, Van Jacobson 和 Scott Stanton 的附加宏. 插图由 John Vlissides 和 +Scott Stanton 设计的 Idraw 完成. 整本书用 L. Peter Deutsch 的 Ghostscript 生成之后, 在 Tim Theisen +的 Ghostview 里预览. Chiron Inc. 公司的 Gary Bisbee 制作了影印版. + +我严重感谢许多其他人, 包括 Paul Becker, Phil Chapnick, Alice Hartley, Glenn Holloway, Meichun Hsu, +Krzysztof Lenk, Arman Maghbouleh, Howard Mullings, Nancy Parmet, Robert Penny, Gary Sabot, +Patrick Slaney, Steve Strassman, Dave Watkins, Weickers 一家, 和 Bill Woods. + +最后, 我要感谢我的父母, 为他们的榜样和鼓励; 还有 Jackie, 他们教给我那些如果我听从他们的教诲就可以学到的知识. + +我希望阅读此书是件快乐的事. 在所有我知道的语言中, 我最喜欢 Lisp, 基本上是因为它是最优美的. 本书正是关于最 +Lisp 化的 Lisp. 写这本书很有趣, 我希望它能反映在字里行间. + +\textsl{Paul Graham} + +%%% Local Variables: +%%% coding: utf-8 +%%% mode: latex +%%% TeX-master: nil +%%% End: Added: books/onlisp/1-the_extensible_language.tex ============================================================================== --- (empty file) +++ books/onlisp/1-the_extensible_language.tex Mon Aug 27 22:13:01 2007 @@ -0,0 +1,239 @@ +\chapter{可扩展语言} +\label{chap:the_extensible_language} + +不久以前当你问 Lisp 能做什么时, 很多人会回答说``用于人工智能''. 事实上, Lisp 和人工智能之间的联系只是历史原因. +Lisp 由 John McCarthy 发明, 他也是 ``人工智能'' 这一术语的发明人. 他的学生和同事们用 Lisp 写程序, +于是它就被称为一种 \textsc{AI} 语言. 这一点在 1980 年代 \textsc{AI} 短暂崛起时又被多次提起, +已经差不多成了惯例. + +幸运的是, 关于 \textsc{AI} 并非 Lisp 全部内容的观点已经传开了. 近年来软硬件的优势已经使 Lisp 具有了商业活力: +它目前用于 GNU Emacs, Unix 下最好的文本编辑器; AutoCAD, 工业标准桌面 \textsc{CAD} 程序; 还有 Interleaf, +领先的高端出版系统. Lisp 在这些程序里的应用跟 \textsc{AI} 已经没有任何关系. + +如果 Lisp 不是一种 \textsc{AI} 语言, 那它是什么? 与其衡量 Lisp 在那些使用它的公司里的应用, +我们不如直接看看语言本身. 什么是你可以用 Lisp 做到而其他语言做不到的呢? +Lisp 的一个最显著的特征是可以根据用它写的程序来量身定做. Lisp 本身就是一个 Lisp 程序, Lisp 程序可以表达成列表, +那也是 Lisp 的数据结构. 总之, 这两个原则意味着任何用户都可以为 Lisp 增加新操作符, +而在这些操作符和那些内置的之间是不可区分的. + +\section{渐进式设计} +\label{sec:design_by_evolution} + +由于 Lisp 给了你自定义操作符的自由, 你就可以随意地将它变成你所需要的语言. 如果你在写一个文本编辑器, 那么可以把 +Lisp 转换成专用于写文本编辑器的语言. 如果你在编写 CAD 程序, 那么可以把 Lisp 转换成专用于写 CAD 程序的语言. +并且如果你还不太清楚你要写哪种程序, 那么用 Lisp 来写会比较安全. 无论你想写哪种程序, 在你写的时候, Lisp +都可以演变成用于写 \textsl{那} 种程序的语言. + +如果你还不太确定你要写哪种程序? 对有些人来说，这句话已经是老一套了\footnote{感谢 88:barbieQ +同学提供该句的专业翻译, 原文是``To some ears that sentence has an odd ring to it.}. +这与特定的做事模式有巨大差异: 在特定的做事模式中, (1) 仔细计划你打算做的事情, (2) 去执行它. +在这种模式下, 如果 Lisp 鼓励你在决定程序应该如何工作之前就开始写程序, 它只不过是鼓励了草率的思考而已. + +那么, 事情不是这样的. 先策划再实现的方法可能是建造水坝或者发起袭击的方式, 但经验并未显示这也是一种写程序的良好方式. +为什么? 也许是因为计算机要求得太苛刻了. 也许是因为程序之中包含比水坝或者袭击更多的变数. +或者也许老方法不再奏效是因为旧式的冗余观念不适合于软件开发: 如果一个大坝包含有额外 $30\%$ 的混凝土, +那么可能处在一个错误的边缘, 但如果一个程序多做了额外 $30\%$ 的工作, 那 \textsl{就是} 一个错误. + +很难说清楚为何旧的方法失效了, 但一旦真的失效, 任何人都能看到. 究竟什么时候软件按时交付过? +有经验的程序员知道无论你多小心地计划一个程序, 当你写它的时候, 之前制定的计划在某些地方就会变得不够完美. +有时计划会毫无希望地错掉. 却很少有先策划再实施这一方法的受害者出来质疑它的有效性. 相反他们埋怨人的过失: +只要计划做的更有前瞻性, 所有的麻烦就都可以避免. 由于即使最杰出的程序员在他们进行具体实现的时候也难免陷入麻烦, +一味地要求人们必须具备那种程度的前瞻性可能有些过份了. +也许这种先策划再实施的方法可以被另外一种更适合我们自身限制的观点取代. + +如果有合适的工具, 我们完全可以换一种角度看待编程. 为什么我们要在具体实现之前计划好一切呢? +盲目开始一个项目的最大危险是我们可能不小心就使自己陷入困境. 但如果我们有一种更加灵活的语言, 这种担心能减轻一些吗? +我们可以, 而且确实是这样. Lisp 的灵活性带来了全新的编程方式. 在 Lisp 中, 可以边写程序边做计划. + +为什么要等待事后聪明呢? 在 Montaigne 项目成立之初, 除了开始写以外几乎没什么明确的思路. +一旦你可以从使自己陷入困境的危险中解脱出来, 那你就可以完全地驾驭这种可能性. 边设计边施工有两个重要的后果: +程序可以花更少的时间去写, 因为当你把计划和实际动手写放在一起的时候, 你总可以集中精力在一个实际的程序上; +然后让它变得越来越好, 因为最终的设计总是进化的产物. 只要在搜寻你程序的命运时维持一个确定的原则--- +只要你每当发现一个明确的错误时就直接把错误的部分重写掉--- +那么最终的产品可能比上手之前你花几个星期的时间精心设计的结果更加优雅. + +Lisp 的适应能力使这种编程思想成为可能. 确实, Lisp 的最大危险是它可能毁了你. 一旦你用过 Lisp 一段时间, +你可能会对语言和应用程序之间的衔接过于敏感以至于你再能够回到另一种语言, +那种你感觉并不能给你很多你所需要的灵活性的语言. + +\section{自底向上编程} +\label{sec:programming_bottom-up} + +一个长期存在的编程原则是作为程序的功能性单元不应该过于庞大. 如果程序里某些组件的规模增长超过了它可读的程度, +它就会成为可能隐藏错误的巨大复杂度来源, 就好像巨大的城市里的逃犯那样难以捉摸. 这样的软件将难以阅读, 难以测试, +也难以调试. + +按照这一原则, 一个大型程序必须细分成小块, 并且越大规模的程序就应该分得越细. 但你怎样分割一个程序? +传统的观点称为 \textsl{自顶向下设计}: 你说 ``该程序的目的是做这七件事, 那么我就把它分割成七个主要的子例程. +第一个子例程要做这四件事, 所以它将进一步细分为它自己的四个子例程,'' 诸如此类. +这一过程持续到整个程序被细分到合适的粒度---每一部分都足够大可以做一些实际的事情, +但也足够小到可以作为一个基本单元来理解. + +有经验的 Lisp 程序员用另一种不同的方式来细化他们的程序. 类似自顶向下的设计那样, 他们根据一种称为 +\textsl{自底向上的设计} 原则来处理---通过改变语言来适应程序. 在 Lisp 中, 你不仅是根据语言向下写程序, +也可以根据程序向上构造语言. 在你编程的时候你可能会想 ``我希望 Lisp 这样或者那样的操作符.'' +于是你就可以直接去实现它. 后来你意识到使用新的操作符可以简化程序中另一部分的设计, 诸如此类. 语言和程序一同演变. +就像交战两国的边界一样, 语言和程序的界限不断地变化, 直到最终它们稳定在山川和河流的边缘, +这也就是你要解决的问题本身的自然边界. 最后你的程序看起来就好像语言就是为解决它而设计的. +并且当语言和程序都非常适应彼此时, 你得到的将是清晰, 短小和高效的代码. + +值得强调的是, 自底向上的设计并不意味着只是以不同的顺序写同一个程序. 当你以自底向上的方式工作时, +你通常得到的是一个完全不同的程序. 你将得到一个带有更多抽象操作符的更大的语言, 和一个用它写的更小的程序, +而不是一个简单的整块的程序. 你将得到一个拱而不是梁. + +在典型的代码中, 一旦把那些纯属 bookkeeping 的代码抽象出来, 剩下的东西就很短了; 你构造的语言越高阶, +程序从上到下的距离就越短. 这带来了几点好处: + +\begin{enumerate} +\item + 通过让语言做更多的工作, 自底向上设计产生的程序更加短小轻快. 一个更短小的程序就不必划分成许多的组件, + 并且更少的组件意味着程序更易于阅读和修改. 更少的组件也意味着更少的组件之间的连接, 这样也会减少错误发生的机会. + 一个工业设计者往往努力地减少一台机器上运动部件的数量, 同样有经验的 Lisp + 程序员使用自底向上的设计方法来减少他们程序的规模和复杂度. +\item + 自底向上的设计促进了代码重用. 当你写两个或更多程序时, 许多你为第一个程序所写的工具也对后面的程序也有用. + 一旦你攒下来雄厚的工具基础, 写一个新程序所花的成本相比从裸 Lisp 环境开始可能只有几分之一. +\item + 自底向上的设计提高了程序的可读性. 一个这种类型的抽象要求读者去理解一个通用操作符, + 而一个具体的函数抽象则要求读者去理解一个专用的子例程. +\item + 由于自底向上的设计导致你总是去关注代码中的模式, 这种工作方式有助于澄清设计程序时的思路. + 如果一个程序中两个相距遥远的组件在形式上很相似, 你可能就会注意到这种相似性然后可能会以更简单的方式重新设计程序. +\end{enumerate} + +自底向上的设计对于其他非 Lisp 语言来说也能达到一定程度. 当你看到库函数的时候, 那就是自底向上设计的结果. +尽管如此, Lisp 带给你该领域更广阔的力量, 在 Lisp 风格程序中语言这一角色重要性也成比例地增加了--- +因此 Lisp 不仅是另一种不同的语言, 更是一整套完全不同的编程方式. + +可以认为这种开发风格更加适合那类基于小组开发的程序. 无论如何, 在相同的时间里, 它提高了一个小组所能做的事情的限制. +在 \textsl{The Mythical Man--Month} 一书中, Frederick Brooks +提出了一组程序员的生产力并不随人员数量线性增长的命题. 随着组内人数的提高, 个体程序员的生产力将有所下降. +Lisp 编程经验以一种更加令人振奋的方式表明如下定律: 随着组内人数的减少, 个体程序员的生产力将有所提高. +一个小组的成功, 相对而言, 仅仅是因为它规模小. 当一个小组开始运用 Lisp 所带来的技术优势时, 它毫无疑问地会走向成功. + +\section{可扩展软件} +\label{sec:extensible_software} + +随着软件复杂性的提高, Lisp 编程风格的重要性正在逐步提高.专业用户现在对软件的要求如此之多以致于我们几乎不可能预见% +到他们的所有需求. 但如果我们不能给他们一个能做到他们想要的每一件事的软件, 我们可以给他们一个可扩展的软件. +我们把自己的软件从仅是一个程序转化成一个编程语言, 然后高级用户就可以在此基础上构建他们需要的额外特性. + +自底向上的设计很自然地产生了可扩展的程序. 最简单的自底向上程序包括两层: 语言和程序. 复杂程序可以被写成一系列层, +每一层作为其上层的编程语言. 如果这一哲学被一直用到最上面的那层, 那这层对于用户来说就变成了一门编程语言. +这样一个可扩展性渗透到每一层次的程序, 相比那些先按照传统黑箱方法写成, +然后又想得到可扩展性的那些系统来说, 可以成为一个好得多的编程语言. + +X Window 和 \TeX 是基于此设计原则的早期实例. 在 1980 年代, 更强大的硬件使那些将 Lisp +作为扩展语言的新一代的程序成为可能. 首先是 GNU Emacs, 流行的 Unix 文本编辑器. 紧接着是 AutoCAD, +第一个提供 Lisp 作为其扩展语言的大规模商业产品. 1991 年 Interleaf 发布了他们软件的新版本, 它不仅采用 +Lisp 作为扩展语言, 甚至该软件大部分是用 Lisp 实现的. + +Lisp 是一个用来编写可扩展程序的特别好的语言, 主要是因为它本身就是一个可扩展的程序. 如果你用 Lisp +写你的程序以便将这种可扩展性传递到用户那里, 你事实上已经毫不费力地得到了一个可扩展语言. 并且用 Lisp +扩展一个 Lisp 程序, 和用一个传统语言做同样的事情相比, 它们的区别就好像面对面和使用书信跟人交谈那样. +在一个以简单地提供访问外部程序的方式来达到可扩展性的程序里, 我们能期待的最好的事情也无非是两个黑箱之间彼此% +通过预先定义好的频道进行通信. 在 Lisp 里, 这些扩展有权限直接访问整个底层程序. 这并不是说你给了用户访问你% +程序中每一个部分的权限---只是说你现在至少有 \textsl{机会} 决定是否给他们这样的权限. + +当这种程序的权限和交互式环境组合在一起的时候, 你就拥有了发挥到极致的可扩展性. 任何你想用来作为扩展基础的软件, +在你心里就好比有了一个巨大, 非常大的完整的蓝图. 如果其中的某些东西不敢确定怎么办? 如果原始程序是用 Lisp +开发的, 那就可以交互式地试探它: 你可以检查它的数据结构; 你可以调用它的函数; 你可能甚至可以去看它最初的源代码. +这种反馈信息允许你以很高的置信度来写程序---去写更加雄心勃勃的扩展, 并且让他们更快. +交互式环境总是可以使编程更加简单, 但它对写扩展的人来说无疑更具价值. + +可扩展的程序是一把双刃剑, 但近来的经验表明, 相比一把钝剑来说用户更喜欢双刃剑. 可扩展的程序看起来正在流行, +不论它们是否暗含危险. + +\section{扩展 Lisp} +\label{sec:extending_lisp} + +有两种方式可以给 Lisp 增加新操作符: 函数和宏. 在 Lisp 里, 你定义的函数和那些内置函数具有相同的状态. +如果你想要一个新变种的 \texttt{mapcar}, 那你就可以自己定义然后就像使用 \texttt{mapcar} 那样来使用它. +例如, 如果你想要某个函数当把从 1 到 10 的所有整数分别传给它以后得到的值的一个列表, +你可以创建一个新列表然后把它传给 \texttt{mapcar}: + +\begin{verbatim} +(mapcar fn + (do* ((x 1 (1+ x)) + (result (list x) (push x result))) + ((= x 10) (nreverse result)))) +\end{verbatim} + +但这种手法既不美观又缺乏效率.\footnote{你也可以使用 Common Lisp 的 series 宏把代码写得更简洁, +但那也只能证明同样观点, 因为这些宏就是 Lisp 本身的扩展} 反过来你也可以定义一个新的映射函数 +\texttt{map1-n} (见某页), 然后用如下方式调用它: + +\begin{verbatim} +(map1-n fn 10) +\end{verbatim} + +定义函数相对来说比较清楚明白. 宏提供了一种更通用, 但不太容易理解的定义新操作符的手段. 宏是用来写程序的程序. +这句话意味深长, 深入地探究这个问题正是本书的主要目的. + +考虑周到地使用宏, 可以使程序令人惊叹地清晰简洁. 这些好处绝非唾手可得. 尽管最后宏将被视为世界上最自然的东西, +但最初理解它们的时候却非常艰难. 部分原因是它们比函数更加一般化, 所以书写它们的时候要考虑的事情更多. +但宏难于理解的最主要原因是它们属 \textsl{外来} 事物. 没有任何其他语言有像 Lisp 宏那样的东西. +所以学习宏可能必须要从头脑中清除从其他语言那里偶然学到的先入为主的观念. 其中最重要的就是程序这一概念要完全颠覆了. +为什么数据结构是流动的并且可改变, 而程序却不能呢? 在 Lisp 中, 程序就是数据, +但这一事实的深层含义需要花一些时间才能体会到. + +如果需要花一些时间才能会用宏, 那它最好值得这样做. 即使像迭代这样平凡的用法中, 宏也可以使程序明显地变得小而清楚. +假设一个程序需要在某个程序体上从 a 到 b 来迭代 x. Lisp 内置的 \texttt{do} 用于更加一般的场合. +对于简单的迭代来说它并不能产生可读性最好的代码: + +\begin{verbatim} +(do ((x a (+ 1 x))) + ((> x b)) + (print x)) +\end{verbatim} + +另一方面, 假如我们可以只写成这样: + +\begin{verbatim} +(for (x a b) + (print x)) +\end{verbatim} + +宏使这成为可能. 使用六行代码 (见某页) 我们就可以把 \texttt{for} 加入到语言中来, 就好像它一开始就在那里一样. +并且正如后面的章节所显示的那样, 写一个 \texttt{for} 对于我们可以用宏来做什么来说还只是个开始. + +你也并不限于每次只给 Lisp 扩展一个函数或者宏. 如果你需要, 就可以在 Lisp 之上构建一个完整的语言, +然后用它来写你的程序. Lisp 对于写编译器和解释器来说是极为优秀的语言, 但它提供了定义新语言的另外一种方式, +通常更加简洁并且当然也只需要更少的工作: 定义一种语言作为 Lisp 的变形. 然后 Lisp 中并未改变的部分可以在新语言里 +(例如算术或者 I/O) 继续被使用, 你只需要实现改变了的部分 (例如控制结构). 以这种方式实现的语言称为 +\textsl{嵌入式语言}. + +嵌入式语言是自底向上程序设计的自然产物. Common Lisp 里已经包括几种. 其中最著名的, \textsc{CLOS}, +将在最后一章里讨论. 但你也可以定义自己的嵌入式语言. 你可以得到一个完全符合你程序需要的语言, +甚至它们最后看起来跟 Lisp 已经非常不同. + +\section{为什么 (或者说何时) 用 Lisp} +\label{sec:why_lisp} + +这些新的可能性并非根植于简单的魔法成分. 在这种观点下, Lisp 就像一个拱顶. 究竟哪一块楔形石头 (拱石) +托起了整个拱呢? 这个问题本身就是错误的; 每一块都是. 如同拱一样, Lisp 是一系列联锁特性的集合. +我们可以列出这些特性中的一部分---动态存储分配和垃圾收集, 运行时类型, 函数对象, 生成列表的内置解析器, +一个接受列表形式的程序的编译器, 交互式环境等等---但 Lisp 的威力不能归功于它们中的任何一种. +是上述这些特性的组合铸就了 Lisp 编程目前的样子. + +过去的二十年里, 人们编程的方式变了. 某些变化---交互式环境, 动态链接, 甚至面向对象程序设计--- +已被零碎地尝试用于其他语言以得到 Lisp 那样的灵活性. 关于拱顶的那个比喻说明了这些语言是如何成功的. + +众所周知, Lisp 和 Fortran 是当前仍在使用中的两门最古老的编程语言. +可能最关键的问题在于它们在语言设计的哲学中体现出截然相反的两种极端. Fortran +被发明出来作为汇编语言的增强. Lisp 被发明出来用于表达算法. 如此截然不同的意图产生了差异极大的不同语言. +Fortran 使编译器作者的生活更轻松; 而 Lisp 则使程序员的生活更轻松. 自从那时起, +大多数编程语言都落在了两极之间. Fortran 和 Lisp 已经也使它们逐渐离中央地带更近. Fortran 现在看起来像 +Algol, 而 Lisp 已经放弃了它年幼时的一些很浪费的语言习惯. + +最初的 Fortran 和 Lisp 在某种程度上定义了一个战场. 战场的一边的口号是 ``效率! (并且另外还包括几乎不可能实现.)'' +在战场的另一边, 口号是 ``抽象! (并且不管怎么说, 这不是产品级软件.)'' 就好像上帝从远处决定古希腊战争的结果那样, +编程语言这场战争的结果取决于硬件. 每一年看起来都对 Lisp 更有利. 现在针对 Lisp 的争论听起来已经有点儿像 +1970 年代早期汇编语言程序员对高级语言说的那样. 问题不再是 \textsl{为什么用 Lisp?}, 而是 +\textsl{何时用 Lisp?} + +%%% Local Variables: +%%% coding: utf-8 +%%% mode: latex +%%% TeX-master: nil +%%% End: Added: books/onlisp/2-functions.tex ============================================================================== --- (empty file) +++ books/onlisp/2-functions.tex Mon Aug 27 22:13:01 2007 @@ -0,0 +1,10 @@ +\chapter{函数} +\label{chap:functions} + +函数是 Lisp 程序的构造单元. 它们也是 Lisp 的构造单元. + +%%% Local Variables: +%%% coding: utf-8 +%%% mode: latex +%%% TeX-master: nil +%%% End: Added: books/onlisp/24-prolog.tex ============================================================================== --- (empty file) +++ books/onlisp/24-prolog.tex Mon Aug 27 22:13:01 2007 @@ -0,0 +1,8 @@ +\chapter{Prolog} +\label{chap:prolog} + +%%% Local Variables: +%%% coding: utf-8 +%%% mode: latex +%%% TeX-master: nil +%%% End: Added: books/onlisp/3-functional_programming.tex ============================================================================== --- (empty file) +++ books/onlisp/3-functional_programming.tex Mon Aug 27 22:13:01 2007 @@ -0,0 +1,8 @@ +\chapter{函数型编程} +\label{chap:functional_programming} + +%%% Local Variables: +%%% coding: utf-8 +%%% mode: latex +%%% TeX-master: nil +%%% End: Added: books/onlisp/notes.tex ============================================================================== --- (empty file) +++ books/onlisp/notes.tex Mon Aug 27 22:13:01 2007 @@ -0,0 +1,8 @@ +\chapter*{Notes} +\label{chap:notes} + +%%% Local Variables: +%%% coding: utf-8 +%%% mode: latex +%%% TeX-master: nil +%%% End: Added: books/onlisp/onlisp.kilepr ============================================================================== --- (empty file) +++ books/onlisp/onlisp.kilepr Mon Aug 27 22:13:01 2007 @@ -0,0 +1,32 @@ +[General] +img_extIsRegExp=false +img_extensions=.eps .pdf .dvi .ps .fig .gif .jpg .jpeg .png +kileprversion=1 +kileversion=1.9.3 +lastDocument=onlisp.tex +masterDocument= +name=onlisp +pkg_extIsRegExp=false +pkg_extensions=.cls .sty .dtx +src_extIsRegExp=false +src_extensions=.tex .ltx .bib .mp + +[Tools] +MakeIndex= +QuickBuild= + +[item:onlisp.kilepr] +archive=true +column=148039600 +encoding= +highlight= +line=0 +open=false + +[item:onlisp.tex] +archive=true +column=35 +encoding=UTF-8 +highlight=LaTeX +line=11 +open=true Added: books/onlisp/onlisp.tex ============================================================================== --- (empty file) +++ books/onlisp/onlisp.tex Mon Aug 27 22:13:01 2007 @@ -0,0 +1,34 @@ +\documentclass[a4paper,10pt]{book} +\usepackage{CJK} +\usepackage{indentfirst} + +\begin{document} +\begin{CJK}{UTF8}{song} +\CJKindent + +\begin{titlepage} +\title{On Lisp\footnote{原书地址: \texttt{http://www.paulgraham.com/onlisp.html}}} +\author{Paul Graham 著 + \and Chun Tian (binghe) 译\footnote{\texttt{E-mail: binghe.lisp(a)gmail.com}}} +\end{titlepage} + +\maketitle +\include{0-preface} +\tableofcontents +\setcounter{page}{0} +\include{1-the_extensible_language} +\include{2-functions} +\include{3-functional_programming} +\include{24-prolog} + +\include{packages} +\include{notes} + +\end{CJK} +\end{document} + +%%% Local Variables: +%%% coding: utf-8 +%%% mode: latex +%%% TeX-master: t +%%% End: Added: books/onlisp/packages.tex ============================================================================== --- (empty file) +++ books/onlisp/packages.tex Mon Aug 27 22:13:01 2007 @@ -0,0 +1,8 @@ +\chapter*{Appendix: Packages} +\label{chap:packages} + +%%% Local Variables: +%%% coding: utf-8 +%%% mode: latex +%%% TeX-master: nil +%%% End:

1 0

[cl-net-snmp-cvs] r23 - trunk
by ctian＠common-lisp.net 08 Jun '07

08 Jun '07

Author: ctian Date: Fri Jun 8 13:30:33 2007 New Revision: 23 Modified: trunk/classes.lisp Log: type bug, only openmcl found it... Modified: trunk/classes.lisp ============================================================================== --- trunk/classes.lisp (original) +++ trunk/classes.lisp Fri Jun 8 13:30:33 2007 @@ -31,7 +31,7 @@ :initform "binghe") (security-level :reader snmp-security-level :initarg :security-level - :type string + :type integer :initform +snmp-sec-level-authnopriv+) (security-auth-proto :reader snmp-security-auth-proto :initarg :security-auth-proto

1 0

[cl-net-snmp-cvs] r22 - trunk
by ctian＠common-lisp.net 07 Jun '07

07 Jun '07

Author: ctian Date: Thu Jun 7 09:52:18 2007 New Revision: 22 Modified: trunk/typedefs.lisp Log: more precise size_t Modified: trunk/typedefs.lisp ============================================================================== --- trunk/typedefs.lisp (original) +++ trunk/typedefs.lisp Thu Jun 7 09:52:18 2007 @@ -1,7 +1,11 @@ (in-package :org.net-snmp) +#+(or x86-64 clisp) (defctype c-size-type :ulong) +#+x86 +(defctype c-size-type :uint) + (defcstruct c-snmp-pdu "The snmp protocol data unit." ;;

1 0

[cl-net-snmp-cvs] r21 - trunk
by ctian＠common-lisp.net 07 Jun '07

07 Jun '07

Author: ctian Date: Thu Jun 7 02:38:41 2007 New Revision: 21 Modified: trunk/net-snmp.asd Log: remove fli:* Modified: trunk/net-snmp.asd ============================================================================== --- trunk/net-snmp.asd (original) +++ trunk/net-snmp.asd Thu Jun 7 02:38:41 2007 @@ -33,6 +33,6 @@ (:file "zilong" :depends-on ("sabrina")))) ;; (fli:start-collecting-template-info) -(defun make-fli-templates () - (with-open-file (stream "fli-templates.lisp" :direction :output) - (fli:print-collected-template-info :output-stream stream))) +;;(defun make-fli-templates () +;; (with-open-file (stream "fli-templates.lisp" :direction :output) +;; (fli:print-collected-template-info :output-stream stream)))

1 0

[cl-net-snmp-cvs] r20 - trunk
by ctian＠common-lisp.net 07 Jun '07

07 Jun '07

Author: ctian Date: Thu Jun 7 02:23:53 2007 New Revision: 20 Added: trunk/advance.lisp trunk/zilong.lisp Modified: trunk/asn1.lisp trunk/classes.lisp trunk/load.lisp trunk/net-snmp.asd trunk/package.lisp trunk/snmp-api.lisp Log: use cffi again, since I can patch it to support 64bit lispworks Added: trunk/advance.lisp ============================================================================== --- (empty file) +++ trunk/advance.lisp Thu Jun 7 02:23:53 2007 @@ -0,0 +1,2 @@ +(in-package :org.net-snmp) + Modified: trunk/asn1.lisp ============================================================================== --- trunk/asn1.lisp (original) +++ trunk/asn1.lisp Thu Jun 7 02:23:53 2007 @@ -6,30 +6,15 @@ c-oids c-oid-len)) -#-lispworks (defmethod shared-initialize :after ((instance oid) slot-names &rest initargs) (declare (ignore slot-names initargs)) (with-slots (name length c-oids c-oid-len) instance (progn (setf c-oids (foreign-alloc 'c-oid :count +max-oid-len+) c-oid-len (foreign-alloc 'c-size-type :initial-element +max-oid-len+)) - (if (and (> (length name) 0) - (eq (elt name 0) #\.)) - (c-read-objid name c-oids c-oid-len) - (c-get-node name c-oids c-oid-len)) + (c-read-objid name c-oids c-oid-len) (setf length (mem-ref c-oid-len 'c-size-type))))) -#+lispworks -(defmethod shared-initialize :after ((instance oid) slot-names &rest initargs) - (declare (ignore slot-names initargs)) - (with-slots (name length c-oids c-oid-len) instance - (progn - (setf c-oids (fli:allocate-foreign-object :type 'oid :nelems +max-oid-len+) - c-oid-len (fli:allocate-foreign-object :type 'size-t)) - (read-objid name c-oids c-oid-len) - (setf length (fli:dereference c-oid-len))))) - -#-lispworks (defun snmp-var->value (v) (case (foreign-slot-value v 'c-variable-list 'c-type) ;; ASN_INTEGER @@ -42,19 +27,3 @@ (foreign-slot-value v 'c-variable-list 'c-val) (foreign-slot-value v 'c-variable-list 'c-val-len))) (otherwise :others))) - -#+lispworks -(defun snmp-var->value (v) - (case (fli:foreign-slot-value v 'type) - ;; ASN_INTEGER - (#x02 - (fli:dereference - (fli:foreign-slot-value (fli:foreign-slot-pointer v 'val) - 'integer))) - ;; ASN_OCTET_STR - (#x04 - (fli:convert-from-foreign-string - (fli:foreign-slot-value (fli:foreign-slot-pointer v 'val) - 'string) - :length (fli:foreign-slot-value v 'val-len))) - (otherwise (fli:foreign-slot-value v 'type)))) Modified: trunk/classes.lisp ============================================================================== --- trunk/classes.lisp (original) +++ trunk/classes.lisp Thu Jun 7 02:23:53 2007 @@ -42,7 +42,6 @@ :initform "01234567") c-session)) -#-lispworks (defmethod shared-initialize :after ((instance snmp-session) slot-names &rest initargs) (declare (ignore slot-names initargs)) (with-slots (peername version c-session) instance @@ -101,49 +100,6 @@ (error "Error generating Ku from authentication pass phrase."))))))) (t (error "unknown snmp version!")))))) -#+lispworks -(defmethod shared-initialize :after ((instance snmp-session) slot-names &rest initargs) - (declare (ignore slot-names initargs)) - (with-slots (peername version c-session) instance - (progn - (setf c-session (fli:allocate-foreign-object :type 'netsnmp-session)) - (snmp-sess-init c-session) - (setf (fli:foreign-slot-value c-session 'peername) (fli:convert-to-foreign-string peername) - (fli:foreign-slot-value c-session 'version) version) - (cond ((or (= version +snmp-version-1+) - (= version +snmp-version-2c+)) - (with-slots (community) instance - (setf (fli:foreign-slot-value c-session 'community) (fli:convert-to-foreign-string community) - (fli:foreign-slot-value c-session 'community-len) (length community)))) - ;; SNMPv3 support - ((= version +snmp-version-3+) - (with-slots (security-name security-auth-proto passphrase) instance - (progn - (setf (fli:foreign-slot-value c-session 'security-name) (fli:convert-to-foreign-string security-name) - (fli:foreign-slot-value c-session 'security-name-len) (length security-name) - ;; we only support authNoPriv now - (fli:foreign-slot-value c-session 'security-level) +snmp-sec-level-authnopriv+ - (fli:foreign-slot-value c-session 'security-auth-key-len) +usm-auth-ku-len+) - (case security-auth-proto - (:hmac-md5 - (setf (fli:foreign-slot-value c-session 'security-auth-proto) +usm-hmac-md5-auth-protocol+ - (fli:foreign-slot-value c-session 'security-auth-proto-len) +usm-hmac-md5-auth-protocol-len+)) - (:hmac-sha1 - (setf (fli:foreign-slot-value c-session 'security-auth-proto) +usm-hmac-sha1-auth-protocol+ - (fli:foreign-slot-value c-session 'security-auth-proto-len) +usm-hmac-sha1-auth-protocol-len+))) - (fli:with-foreign-string (c-passphrase c-passphrase-len byte-count) - passphrase - (declare (ignore byte-count)) - (if (/= (generate-ku (fli:foreign-slot-value c-session 'security-auth-proto) - (fli:foreign-slot-value c-session 'security-auth-proto-len) - c-passphrase - c-passphrase-len - (fli:foreign-array-pointer (fli:foreign-slot-pointer c-session 'security-auth-key) 0) - (fli:foreign-slot-pointer c-session 'security-auth-key-len)) - +snmp-err-success+) - (error "Error generating Ku from authentication pass phrase.")))))) - (t (error "unknown snmp version!")))))) - (defmethod snmp-msg-get ((s snmp-session) (o oid)) (car (snmp-msg-get-list s (list o)))) @@ -156,7 +112,6 @@ (defmethod snmp-msg-get ((s string) (o oid)) (snmp-msg-get (make-instance 'snmp-session :peername s) o)) -#-lispworks (defmethod snmp-msg-get-list ((s snmp-session) (oids list)) (let ((ss (c-snmp-open (slot-value s 'c-session))) (pdu (c-snmp-pdu-create +snmp-msg-get+)) @@ -176,47 +131,21 @@ (let ((status (c-snmp-synch-response ss pdu response))) (setf values (if (and (= status +snmp-stat-success+) - (= (foreign-slot-value (mem-aref response :pointer) 'c-snmp-pdu 'c-errstat) + (= (foreign-slot-value (mem-aref response :pointer) + 'c-snmp-pdu + 'c-errstat) +snmp-err-noerror+)) - (loop for vars = (foreign-slot-value (mem-aref response :pointer) - 'c-snmp-pdu 'c-variables) - then (foreign-slot-value vars 'c-variable-list 'c-next-variable) + (loop for vars = (foreign-slot-value (mem-aref response :pointer) + 'c-snmp-pdu + 'c-variables) + then (foreign-slot-value vars + 'c-variable-list + 'c-next-variable) until (null-pointer-p vars) collect (snmp-var->value vars))))) (c-snmp-pdu-free (mem-aref response :pointer)) (c-snmp-close ss) values))) -#+lispworks -(defmethod snmp-msg-get-list ((s snmp-session) (oids list)) - (let ((ss (snmp-open (slot-value s 'c-session))) - (pdu (snmp-pdu-create +snmp-msg-get+)) - values) - (fli:with-dynamic-foreign-objects ((response (:pointer netsnmp-pdu))) - (progn - ;; 1. fill oids into request pdu - (dolist (o oids) - (let ((real-o (typecase o - (oid o) - (string (make-instance 'oid :name o)) - (t (error "unknown oid type"))))) - (snmp-add-null-var pdu - (slot-value real-o 'c-oids) - (fli:dereference (slot-value real-o 'c-oid-len))))) - ;; 2. get results from response pdu - (let ((status (snmp-synch-response ss pdu response))) - (setf values - (if (and (= status +snmp-stat-success+) - (= (fli:foreign-slot-value (fli:dereference response) 'errstat) - +snmp-err-noerror+)) - (loop for vars = (fli:foreign-slot-value (fli:dereference response) - 'variables) - then (fli:foreign-slot-value vars 'next-variable) - until (fli:null-pointer-p vars) - collect (snmp-var->value vars))))) - (snmp-free-pdu (fli:dereference response)) - (snmp-close ss) - values)))) - (defmethod snmp-msg-get-list ((s string) (oids list)) (snmp-msg-get-list (make-instance 'snmp-session :peername s) oids)) Modified: trunk/load.lisp ============================================================================== --- trunk/load.lisp (original) +++ trunk/load.lisp Thu Jun 7 02:23:53 2007 @@ -1,6 +1,5 @@ (in-package :org.net-snmp) (eval-when (:load-toplevel) - (init-snmp "snmpapp") + (c-snmp-init "snmpapp") (format t "Net-SNMP Initialized.~%")) - Modified: trunk/net-snmp.asd ============================================================================== --- trunk/net-snmp.asd (original) +++ trunk/net-snmp.asd Thu Jun 7 02:23:53 2007 @@ -1,41 +1,36 @@ ;;;; -*- Mode: Lisp -*- +(in-package :cl-user) + (defpackage :net-snmp-system (:use :cl :asdf)) (in-package :net-snmp-system) -(require "foreign-parser") -(require "sql") - (defsystem net-snmp :description "Common Lisp interface for Net-SNMP" - :version "0.5" + :version "0.6" :author "Chun Tian (binghe) <binghe.lisp(a)gmail.com>" - :depends-on (#-lispworks :cffi) + :depends-on (:cffi) :components ((:file "package") (:file "constants" :depends-on ("package")) - #-lispworks (:file "typedefs" :depends-on ("constants")) - #+lispworks (:file "net-snmp-dff" :depends-on ("constants")) - #+lispworks (:file "lw-dff" :depends-on ("net-snmp-dff")) - #+lispworks (:file "load" :depends-on ("lw-dff")) - #-lispworks (:file "snmp-api" :depends-on ("constants" "typedefs")) - (:file "asn1" :depends-on (#-lispworks "typedefs" #+lispworks "load")) - (:file "classes" :depends-on ("asn1")))) + (:file "typedefs" :depends-on ("constants")) + (:file "snmp-api" :depends-on ("typedefs")) + (:file "load" :depends-on ("snmp-api")) + (:file "asn1" :depends-on ("load")) + (:file "classes" :depends-on ("asn1")) + (:file "advance" :depends-on ("classes")))) (defsystem sabrina :description "Sabrina - Update server status into database" :version "0.1" :author "Chun Tian (binghe) <binghe.lisp(a)gmail.com>" :depends-on (:net-snmp - :net-telent-date) - :components ((:file "sabrina"))) - -(defun make-fli-dff () - (foreign-parser:process-foreign-file "net-snmp.h" - :dff "net-snmp-dff.lisp" - :case-sensitive :split-name - :package :org.net-snmp)) + :net-telent-date + :hunchentoot + :clsql-postgresql) + :components ((:file "sabrina") + (:file "zilong" :depends-on ("sabrina")))) ;; (fli:start-collecting-template-info) (defun make-fli-templates () Modified: trunk/package.lisp ============================================================================== --- trunk/package.lisp (original) +++ trunk/package.lisp Thu Jun 7 02:23:53 2007 @@ -2,7 +2,7 @@ (defpackage :org.net-snmp (:nicknames :snmp) - (:use :cl #-lispworks :cffi) + (:use :cl :cffi) (:export ;; class snmp-session oid @@ -16,13 +16,8 @@ (in-package :org.net-snmp) -#-lispworks (eval-when (:compile-toplevel :load-toplevel) (define-foreign-library libsnmp (:unix "libsnmp.so") (t (:default "libsnmp"))) (use-foreign-library libsnmp)) - -#+lispworks -(eval-when (:compile-toplevel :load-toplevel) - (fli:register-module "libsnmp.so")) Modified: trunk/snmp-api.lisp ============================================================================== --- trunk/snmp-api.lisp (original) +++ trunk/snmp-api.lisp Thu Jun 7 02:23:53 2007 @@ -1,11 +1,6 @@ (in-package :org.net-snmp) -(eval-when (:compile-toplevel :load-toplevel) - (defcfun ("init_snmp" c-snmp-init) :void (type :string))) - -(eval-when (:load-toplevel :execute) - (progn (c-snmp-init "snmpapp") - (format t "c-snmp-init called.~%"))) +(defcfun ("init_snmp" c-snmp-init) :void (type :string)) ;;; ;;; Initializes the session structure. Added: trunk/zilong.lisp ============================================================================== --- (empty file) +++ trunk/zilong.lisp Thu Jun 7 02:23:53 2007 @@ -0,0 +1,2 @@ +(in-package :org.net-snmp.sabrina) +

1 0

[cl-net-snmp-cvs] r19 - trunk
by ctian＠common-lisp.net 25 May '07

25 May '07

Author: ctian Date: Fri May 25 03:50:55 2007 New Revision: 19 Added: trunk/load.lisp Removed: trunk/scripts.lisp Modified: trunk/asn1.lisp trunk/lw-dff.lisp trunk/net-snmp-dff.lisp trunk/net-snmp.asd trunk/net-snmp.h Log: clean up eval-whens Modified: trunk/asn1.lisp ============================================================================== --- trunk/asn1.lisp (original) +++ trunk/asn1.lisp Fri May 25 03:50:55 2007 @@ -1,34 +1,33 @@ (in-package :org.net-snmp) -(eval-when (:compile-toplevel :load-toplevel) - (defclass oid () - ((name :type string :reader oid-name :initarg :name) - (length :type integer :reader oid-length) - c-oids - c-oid-len)) +(defclass oid () + ((name :type string :reader oid-name :initarg :name) + (length :type integer :reader oid-length) + c-oids + c-oid-len)) - #-lispworks - (defmethod shared-initialize :after ((instance oid) slot-names &rest initargs) - (declare (ignore slot-names initargs)) - (with-slots (name length c-oids c-oid-len) instance - (progn - (setf c-oids (foreign-alloc 'c-oid :count +max-oid-len+) - c-oid-len (foreign-alloc 'c-size-type :initial-element +max-oid-len+)) - (if (and (> (length name) 0) - (eq (elt name 0) #\.)) - (c-read-objid name c-oids c-oid-len) - (c-get-node name c-oids c-oid-len)) - (setf length (mem-ref c-oid-len 'c-size-type))))) +#-lispworks +(defmethod shared-initialize :after ((instance oid) slot-names &rest initargs) + (declare (ignore slot-names initargs)) + (with-slots (name length c-oids c-oid-len) instance + (progn + (setf c-oids (foreign-alloc 'c-oid :count +max-oid-len+) + c-oid-len (foreign-alloc 'c-size-type :initial-element +max-oid-len+)) + (if (and (> (length name) 0) + (eq (elt name 0) #\.)) + (c-read-objid name c-oids c-oid-len) + (c-get-node name c-oids c-oid-len)) + (setf length (mem-ref c-oid-len 'c-size-type))))) - #+lispworks - (defmethod shared-initialize :after ((instance oid) slot-names &rest initargs) - (declare (ignore slot-names initargs)) - (with-slots (name length c-oids c-oid-len) instance - (progn - (setf c-oids (fli:allocate-foreign-object :type 'oid :nelems +max-oid-len+) - c-oid-len (fli:allocate-foreign-object :type 'size-t)) - (read-objid name c-oids c-oid-len) - (setf length (fli:dereference c-oid-len)))))) +#+lispworks +(defmethod shared-initialize :after ((instance oid) slot-names &rest initargs) + (declare (ignore slot-names initargs)) + (with-slots (name length c-oids c-oid-len) instance + (progn + (setf c-oids (fli:allocate-foreign-object :type 'oid :nelems +max-oid-len+) + c-oid-len (fli:allocate-foreign-object :type 'size-t)) + (read-objid name c-oids c-oid-len) + (setf length (fli:dereference c-oid-len))))) #-lispworks (defun snmp-var->value (v) @@ -55,7 +54,7 @@ ;; ASN_OCTET_STR (#x04 (fli:convert-from-foreign-string - (fli:foreign-slot-value (fli:foreign-slot-pointer v 'val) - 'string) - :length (fli:foreign-slot-value v 'val-len))) + (fli:foreign-slot-value (fli:foreign-slot-pointer v 'val) + 'string) + :length (fli:foreign-slot-value v 'val-len))) (otherwise (fli:foreign-slot-value v 'type)))) Added: trunk/load.lisp ============================================================================== --- (empty file) +++ trunk/load.lisp Fri May 25 03:50:55 2007 @@ -0,0 +1,6 @@ +(in-package :org.net-snmp) + +(eval-when (:load-toplevel) + (init-snmp "snmpapp") + (format t "Net-SNMP Initialized.~%")) + Modified: trunk/lw-dff.lisp ============================================================================== --- trunk/lw-dff.lisp (original) +++ trunk/lw-dff.lisp Fri May 25 03:50:55 2007 @@ -1,33 +1,22 @@ (in-package :org.net-snmp) -(eval-when (:compile-toplevel :load-toplevel) - (fli:define-c-typedef (size-t (:foreign-name "size_t")) - (:unsigned :long)) - (fli:define-c-typedef (u-long (:foreign-name "u_long")) - (:unsigned :long)) - (fli:define-c-typedef (oid (:foreign-name "oid")) u-long) - - (fli:define-foreign-function (init-snmp "init_snmp" :source) - ;; Page 32 of FLI Manual - ((arg-1 (:reference-pass :ef-mb-string))) - :result-type :void - :language :ansi-c) - - (fli:define-foreign-function (read-objid "read_objid" :source) - ((arg-1 (:reference-pass :ef-mb-string)) - (arg-2 (:pointer oid)) - (arg-3 (:pointer size-t))) - :result-type :int - :language :ansi-c) - - (fli:define-foreign-function (get-node "get_node" :source) - ((arg-1 (:reference-pass :ef-mb-string)) - (arg-2 (:pointer oid)) - (arg-3 (:pointer size-t))) - :result-type :int - :language :ansi-c)) - -(eval-when (:load-toplevel) - (init-snmp "snmpapp") - (format t "Net-SNMP Initialized.~%")) +(fli:define-foreign-function (init-snmp "init_snmp" :source) + ;; Page 32 of FLI Manual + ((arg-1 (:reference-pass :ef-mb-string))) + :result-type :void + :language :ansi-c) + +(fli:define-foreign-function (read-objid "read_objid" :source) + ((arg-1 (:reference-pass :ef-mb-string)) + (arg-2 (:pointer oid)) + (arg-3 (:pointer size-t))) + :result-type :int + :language :ansi-c) + +(fli:define-foreign-function (get-node "get_node" :source) + ((arg-1 (:reference-pass :ef-mb-string)) + (arg-2 (:pointer oid)) + (arg-3 (:pointer size-t))) + :result-type :int + :language :ansi-c) Modified: trunk/net-snmp-dff.lisp ============================================================================== --- trunk/net-snmp-dff.lisp (original) +++ trunk/net-snmp-dff.lisp Fri May 25 03:50:55 2007 @@ -1,12 +1,17 @@ -#| DATE : 24 May 2007 +#| DATE : 25 May 2007 | USER : binghe | PROCESSED FILE : net-snmp.h |# -(in-package :org.net-snmp) +(in-package "ORG.NET-SNMP") ;;; Derived from file : "/home/binghe/cl-net-snmp/net-snmp.h" +(fli:define-c-typedef (u-long (:foreign-name "u_long")) + (:unsigned :long)) +(fli:define-c-typedef (size-t (:foreign-name "size_t")) + (:unsigned :long)) +(fli:define-c-typedef (oid (:foreign-name "oid")) u-long) (fli:define-c-typedef (u-char (:foreign-name "u_char")) (:unsigned :char)) (fli:define-c-typedef (u-short (:foreign-name "u_short")) Modified: trunk/net-snmp.asd ============================================================================== --- trunk/net-snmp.asd (original) +++ trunk/net-snmp.asd Fri May 25 03:50:55 2007 @@ -16,10 +16,11 @@ :components ((:file "package") (:file "constants" :depends-on ("package")) #-lispworks (:file "typedefs" :depends-on ("constants")) - #+lispworks (:file "lw-dff" :depends-on ("package")) - #+lispworks (:file "net-snmp-dff" :depends-on ("package")) + #+lispworks (:file "net-snmp-dff" :depends-on ("constants")) + #+lispworks (:file "lw-dff" :depends-on ("net-snmp-dff")) + #+lispworks (:file "load" :depends-on ("lw-dff")) #-lispworks (:file "snmp-api" :depends-on ("constants" "typedefs")) - (:file "asn1" :depends-on (#-lispworks "typedefs" #+lispworks "net-snmp-dff")) + (:file "asn1" :depends-on (#-lispworks "typedefs" #+lispworks "load")) (:file "classes" :depends-on ("asn1")))) (defsystem sabrina @@ -29,3 +30,14 @@ :depends-on (:net-snmp :net-telent-date) :components ((:file "sabrina"))) + +(defun make-fli-dff () + (foreign-parser:process-foreign-file "net-snmp.h" + :dff "net-snmp-dff.lisp" + :case-sensitive :split-name + :package :org.net-snmp)) + +;; (fli:start-collecting-template-info) +(defun make-fli-templates () + (with-open-file (stream "fli-templates.lisp" :direction :output) + (fli:print-collected-template-info :output-stream stream))) Modified: trunk/net-snmp.h ============================================================================== --- trunk/net-snmp.h (original) +++ trunk/net-snmp.h Fri May 25 03:50:55 2007 @@ -1,7 +1,6 @@ typedef unsigned long u_long; typedef unsigned long size_t; typedef u_long oid; - typedef unsigned char u_char; typedef unsigned short u_short; typedef unsigned int u_int;

1 0

[cl-net-snmp-cvs] r18 - trunk
by ctian＠common-lisp.net 24 May '07

24 May '07

Author: ctian Date: Thu May 24 12:53:42 2007 New Revision: 18 Added: trunk/deliver.lisp trunk/sabrina.lisp trunk/scripts.lisp Modified: trunk/asn1.lisp trunk/classes.lisp trunk/constants.lisp trunk/net-snmp-dff.lisp trunk/net-snmp.asd trunk/net-snmp.h Log: Add sabrina, a snmp app Modified: trunk/asn1.lisp ============================================================================== --- trunk/asn1.lisp (original) +++ trunk/asn1.lisp Thu May 24 12:53:42 2007 @@ -30,3 +30,32 @@ (read-objid name c-oids c-oid-len) (setf length (fli:dereference c-oid-len)))))) +#-lispworks +(defun snmp-var->value (v) + (case (foreign-slot-value v 'c-variable-list 'c-type) + ;; ASN_INTEGER + (#x02 + (mem-ref (foreign-slot-value v 'c-variable-list 'c-val) + :uint32)) + ;; ASN_OCTET_STR + (#x04 + (foreign-string-to-lisp + (foreign-slot-value v 'c-variable-list 'c-val) + (foreign-slot-value v 'c-variable-list 'c-val-len))) + (otherwise :others))) + +#+lispworks +(defun snmp-var->value (v) + (case (fli:foreign-slot-value v 'type) + ;; ASN_INTEGER + (#x02 + (fli:dereference + (fli:foreign-slot-value (fli:foreign-slot-pointer v 'val) + 'integer))) + ;; ASN_OCTET_STR + (#x04 + (fli:convert-from-foreign-string + (fli:foreign-slot-value (fli:foreign-slot-pointer v 'val) + 'string) + :length (fli:foreign-slot-value v 'val-len))) + (otherwise (fli:foreign-slot-value v 'type)))) Modified: trunk/classes.lisp ============================================================================== --- trunk/classes.lisp (original) +++ trunk/classes.lisp Thu May 24 12:53:42 2007 @@ -220,33 +220,3 @@ (defmethod snmp-msg-get-list ((s string) (oids list)) (snmp-msg-get-list (make-instance 'snmp-session :peername s) oids)) - -#-lispworks -(defun snmp-var->value (v) - (case (foreign-slot-value v 'c-variable-list 'c-type) - ;; ASN_OCTET_STR - (+asn-octet-str+ - (foreign-string-to-lisp - (foreign-slot-value v 'c-variable-list 'c-val) - (foreign-slot-value v 'c-variable-list 'c-val-len))) - ;; ASN_COUNTER - (+asn-counter+ - (mem-ref (foreign-slot-value v 'c-variable-list 'c-val) - :uint32)) - (otherwise :others))) - -#+lispworks -(defun snmp-var->value (v) - (case (fli:foreign-slot-value v 'type) - ;; ASN_INTEGER - (#x02 - (fli:dereference - (fli:foreign-slot-value (fli:foreign-slot-pointer v 'val) - 'integer))) - ;; ASN_OCTET_STR - (#x04 - (fli:convert-from-foreign-string - (fli:foreign-slot-value (fli:foreign-slot-pointer v 'val) - 'string) - :length (fli:foreign-slot-value v 'val-len))) - (otherwise (fli:foreign-slot-value v 'type)))) Modified: trunk/constants.lisp ============================================================================== --- trunk/constants.lisp (original) +++ trunk/constants.lisp Thu May 24 12:53:42 2007 @@ -38,6 +38,9 @@ (defconstant +asn-counter64+ (logior +asn-application+ 6)) (defconstant +asn-uinteger+ (logior +asn-application+ 7)) +(defconstant +asn-float+ (logior +asn-application+ 8)) +(defconstant +asn-double+ (logior +asn-application+ 9)) + ;;; from snmp.h (defconstant +snmp-version-1+ 0) (defconstant +snmp-version-2c+ 1) Added: trunk/deliver.lisp ============================================================================== --- (empty file) +++ trunk/deliver.lisp Thu May 24 12:53:42 2007 @@ -0,0 +1,12 @@ +(in-package :cl-user) + +(clc:clc-require :net-snmp) + +(defun main () + (format t "~A~%" + (snmp:snmp-msg-get "binghe.people.163.org" ".1.3.6.1.2.1.1.4.0"))) + +(compile 'main) + +(deliver 'main "/tmp/net-snmp" 0 + :multiprocessing nil) Modified: trunk/net-snmp-dff.lisp ============================================================================== --- trunk/net-snmp-dff.lisp (original) +++ trunk/net-snmp-dff.lisp Thu May 24 12:53:42 2007 @@ -262,4 +262,4 @@ :result-type :int :language - :ansi-c) + :ansi-c) \ No newline at end of file Modified: trunk/net-snmp.asd ============================================================================== --- trunk/net-snmp.asd (original) +++ trunk/net-snmp.asd Thu May 24 12:53:42 2007 @@ -5,19 +5,27 @@ (in-package :net-snmp-system) -;;(require "foreign-parser") -;;(foreign-parser:process-foreign-file "net-snmp.h" :case-sensitive :split-name) +(require "foreign-parser") +(require "sql") (defsystem net-snmp :description "Common Lisp interface for Net-SNMP" - :version "0.50" - :author "Chun Tian (binghe)" - ;;:depends-on (:cffi) + :version "0.5" + :author "Chun Tian (binghe) <binghe.lisp(a)gmail.com>" + :depends-on (#-lispworks :cffi) :components ((:file "package") (:file "constants" :depends-on ("package")) #-lispworks (:file "typedefs" :depends-on ("constants")) #+lispworks (:file "lw-dff" :depends-on ("package")) #+lispworks (:file "net-snmp-dff" :depends-on ("package")) #-lispworks (:file "snmp-api" :depends-on ("constants" "typedefs")) - (:file "asn1" :depends-on (#-lispworks "typedefs" #+lispworks "net-snmp-dff")))) - ;;(:file "classes" :depends-on ("snmp-api")))) + (:file "asn1" :depends-on (#-lispworks "typedefs" #+lispworks "net-snmp-dff")) + (:file "classes" :depends-on ("asn1")))) + +(defsystem sabrina + :description "Sabrina - Update server status into database" + :version "0.1" + :author "Chun Tian (binghe) <binghe.lisp(a)gmail.com>" + :depends-on (:net-snmp + :net-telent-date) + :components ((:file "sabrina"))) Modified: trunk/net-snmp.h ============================================================================== --- trunk/net-snmp.h (original) +++ trunk/net-snmp.h Thu May 24 12:53:42 2007 @@ -1,3 +1,7 @@ +typedef unsigned long u_long; +typedef unsigned long size_t; +typedef u_long oid; + typedef unsigned char u_char; typedef unsigned short u_short; typedef unsigned int u_int; @@ -300,7 +304,6 @@ netsnmp_pdu *snmp_pdu_create(int); void snmp_free_pdu(netsnmp_pdu *); const char * snmp_pdu_type(int type); -int get_node(const char *, oid *, size_t *); netsnmp_variable_list *snmp_add_null_var(netsnmp_pdu *, const oid *, size_t); int snmp_synch_response(netsnmp_session *, netsnmp_pdu *, netsnmp_pdu **); Added: trunk/sabrina.lisp ============================================================================== --- (empty file) +++ trunk/sabrina.lisp Thu May 24 12:53:42 2007 @@ -0,0 +1,54 @@ +(defpackage :org.net-snmp.sabrina + (:nicknames :sabrina) + (:use :cl :org.net-snmp :net.telent.date)) + +(in-package :org.net-snmp.sabrina) + +(defvar *oid-map* (make-hash-table)) +(defvar *session-map* (make-hash-table)) + +(defparameter *connect-spec* "dbname=sabrina user=binghe host=fs-30.space.163.org port=5433") + +(eval-when (:compile-toplevel :load-toplevel) + (sql:enable-sql-reader-syntax)) + +(defun connect-to-db () + (sql:connect *connect-spec* :database-type :postgresql)) + +(defun update-oid-map () + (mapcar #'(lambda (x) (unless (gethash (first x) *oid-map*) + (setf (gethash (first x) *oid-map*) + (make-instance 'oid :name (second x))))) + (sql:select [id] [oid] :from [vars]))) + +(defun update-session-map () + (mapcar #'(lambda (x) (unless (gethash (first x) *session-map*) + (setf (gethash (first x) *session-map*) + (make-instance 'snmp-session + :peername (second x) + :version +snmp-version-2c+ + :community "private")))) + (sql:select [id] [hostname] :from [nodes]))) + +(defun update-node-status () + (dolist (n (sql:select [id] [hostname] :from [nodes])) + (destructuring-bind (node-id hostname) n + (format t "Processing ~A~%" hostname) + (let ((vars (mapcar #'(lambda (x) (car x)) + (sql:select [vid] :from [n2v] :where [= [nid] node-id])))) + (commit-data node-id + vars + (snmp-msg-get-list (gethash node-id *session-map*) + (mapcar #'(lambda (x) (gethash x *oid-map*)) vars))))))) + +(defun commit-data (node-id vars datas) + (let ((current-time (universal-time-to-rfc2822-date (get-universal-time) -8))) + (sql:with-transaction + (loop for v in vars + for d in datas + do (sql:insert-records :into [status] + :attributes '(nid ts vid data) + :values (list node-id + current-time + v + d)))))) Added: trunk/scripts.lisp ============================================================================== --- (empty file) +++ trunk/scripts.lisp Thu May 24 12:53:42 2007 @@ -0,0 +1,10 @@ +(in-package :cl-user) + +(defun make-fli-dff () + (foreign-parser:process-foreign-file "net-snmp.h" + :dff "net-snmp-dff-temp.lisp" :case-sensitive :split-name)) + +;; (fli:start-collecting-template-info) +(defun make-fli-templates () + (with-open-file (stream "fli-templates.lisp" :direction :output) + (fli:print-collected-template-info :output-stream stream)))

1 0

[cl-net-snmp-cvs] r17 - trunk
by ctian＠common-lisp.net 23 May '07

23 May '07

Author: ctian Date: Wed May 23 17:36:50 2007 New Revision: 17 Modified: trunk/package.lisp Log: use libsnmp.so Modified: trunk/package.lisp ============================================================================== --- trunk/package.lisp (original) +++ trunk/package.lisp Wed May 23 17:36:50 2007 @@ -19,10 +19,10 @@ #-lispworks (eval-when (:compile-toplevel :load-toplevel) (define-foreign-library libsnmp - (:unix "libsnmp.so.9") + (:unix "libsnmp.so") (t (:default "libsnmp"))) (use-foreign-library libsnmp)) #+lispworks (eval-when (:compile-toplevel :load-toplevel) - (fli:register-module "libsnmp.so.9")) + (fli:register-module "libsnmp.so"))

1 0

[cl-net-snmp-cvs] r16 - trunk
by ctian＠common-lisp.net 23 May '07

23 May '07

Author: ctian Date: Wed May 23 16:08:52 2007 New Revision: 16 Added: trunk/lw-dff.lisp trunk/net-snmp-dff.lisp trunk/net-snmp.h Modified: trunk/asn1.lisp trunk/classes.lisp trunk/net-snmp.asd trunk/package.lisp Log: 64bit LispWorks support added Modified: trunk/asn1.lisp ============================================================================== --- trunk/asn1.lisp (original) +++ trunk/asn1.lisp Wed May 23 16:08:52 2007 @@ -1,12 +1,13 @@ (in-package :org.net-snmp) -(eval-when (:compile-toplevel :load-toplevel :execute) +(eval-when (:compile-toplevel :load-toplevel) (defclass oid () ((name :type string :reader oid-name :initarg :name) (length :type integer :reader oid-length) c-oids c-oid-len)) + #-lispworks (defmethod shared-initialize :after ((instance oid) slot-names &rest initargs) (declare (ignore slot-names initargs)) (with-slots (name length c-oids c-oid-len) instance @@ -19,18 +20,13 @@ (c-get-node name c-oids c-oid-len)) (setf length (mem-ref c-oid-len 'c-size-type))))) - (defmacro snmp-var->value (var) - (let ((v (gensym))) - `(let ((,v ,var)) - (case (foreign-slot-value ,v 'c-variable-list 'c-type) - ;; ASN_OCTET_STR - (,+asn-octet-str+ - (foreign-string-to-lisp - (foreign-slot-value ,v 'c-variable-list 'c-val) - (foreign-slot-value ,v 'c-variable-list 'c-val-len))) - ;; ASN_COUNTER - (,+asn-counter+ - (mem-ref (foreign-slot-value ,v 'c-variable-list 'c-val) - :uint32)) - (otherwise :others)))))) + #+lispworks + (defmethod shared-initialize :after ((instance oid) slot-names &rest initargs) + (declare (ignore slot-names initargs)) + (with-slots (name length c-oids c-oid-len) instance + (progn + (setf c-oids (fli:allocate-foreign-object :type 'oid :nelems +max-oid-len+) + c-oid-len (fli:allocate-foreign-object :type 'size-t)) + (read-objid name c-oids c-oid-len) + (setf length (fli:dereference c-oid-len)))))) Modified: trunk/classes.lisp ============================================================================== --- trunk/classes.lisp (original) +++ trunk/classes.lisp Wed May 23 16:08:52 2007 @@ -27,7 +27,8 @@ :initform "public") (security-name :reader snmp-security-name :initarg :security-name - :type string) + :type string + :initform "binghe") (security-level :reader snmp-security-level :initarg :security-level :type string @@ -38,9 +39,10 @@ :initform :hmac-md5) (passphrase :initarg :passphrase :type string - :initform "binghe") + :initform "01234567") c-session)) +#-lispworks (defmethod shared-initialize :after ((instance snmp-session) slot-names &rest initargs) (declare (ignore slot-names initargs)) (with-slots (peername version c-session) instance @@ -99,6 +101,49 @@ (error "Error generating Ku from authentication pass phrase."))))))) (t (error "unknown snmp version!")))))) +#+lispworks +(defmethod shared-initialize :after ((instance snmp-session) slot-names &rest initargs) + (declare (ignore slot-names initargs)) + (with-slots (peername version c-session) instance + (progn + (setf c-session (fli:allocate-foreign-object :type 'netsnmp-session)) + (snmp-sess-init c-session) + (setf (fli:foreign-slot-value c-session 'peername) (fli:convert-to-foreign-string peername) + (fli:foreign-slot-value c-session 'version) version) + (cond ((or (= version +snmp-version-1+) + (= version +snmp-version-2c+)) + (with-slots (community) instance + (setf (fli:foreign-slot-value c-session 'community) (fli:convert-to-foreign-string community) + (fli:foreign-slot-value c-session 'community-len) (length community)))) + ;; SNMPv3 support + ((= version +snmp-version-3+) + (with-slots (security-name security-auth-proto passphrase) instance + (progn + (setf (fli:foreign-slot-value c-session 'security-name) (fli:convert-to-foreign-string security-name) + (fli:foreign-slot-value c-session 'security-name-len) (length security-name) + ;; we only support authNoPriv now + (fli:foreign-slot-value c-session 'security-level) +snmp-sec-level-authnopriv+ + (fli:foreign-slot-value c-session 'security-auth-key-len) +usm-auth-ku-len+) + (case security-auth-proto + (:hmac-md5 + (setf (fli:foreign-slot-value c-session 'security-auth-proto) +usm-hmac-md5-auth-protocol+ + (fli:foreign-slot-value c-session 'security-auth-proto-len) +usm-hmac-md5-auth-protocol-len+)) + (:hmac-sha1 + (setf (fli:foreign-slot-value c-session 'security-auth-proto) +usm-hmac-sha1-auth-protocol+ + (fli:foreign-slot-value c-session 'security-auth-proto-len) +usm-hmac-sha1-auth-protocol-len+))) + (fli:with-foreign-string (c-passphrase c-passphrase-len byte-count) + passphrase + (declare (ignore byte-count)) + (if (/= (generate-ku (fli:foreign-slot-value c-session 'security-auth-proto) + (fli:foreign-slot-value c-session 'security-auth-proto-len) + c-passphrase + c-passphrase-len + (fli:foreign-array-pointer (fli:foreign-slot-pointer c-session 'security-auth-key) 0) + (fli:foreign-slot-pointer c-session 'security-auth-key-len)) + +snmp-err-success+) + (error "Error generating Ku from authentication pass phrase.")))))) + (t (error "unknown snmp version!")))))) + (defmethod snmp-msg-get ((s snmp-session) (o oid)) (car (snmp-msg-get-list s (list o)))) @@ -108,35 +153,100 @@ (defmethod snmp-msg-get ((s string) (o string)) (snmp-msg-get (make-instance 'snmp-session :peername s) o)) +(defmethod snmp-msg-get ((s string) (o oid)) + (snmp-msg-get (make-instance 'snmp-session :peername s) o)) + +#-lispworks (defmethod snmp-msg-get-list ((s snmp-session) (oids list)) (let ((ss (c-snmp-open (slot-value s 'c-session))) - (pdu (c-snmp-pdu-create +snmp-msg-get+)) - (response (foreign-alloc :pointer :initial-element (null-pointer))) - values) + (pdu (c-snmp-pdu-create +snmp-msg-get+)) + (response (foreign-alloc :pointer :initial-element (null-pointer))) + values) (progn ;; 1. fill oids into request pdu (dolist (o oids) - (let ((real-o (typecase o - (oid o) - (string (make-instance 'oid :name o)) - (t (make-instance 'oid :name ""))))) - (c-snmp-add-null-var pdu - (slot-value real-o 'c-oids) - (mem-ref (slot-value real-o 'c-oid-len) 'c-size-type)))) + (let ((real-o (typecase o + (oid o) + (string (make-instance 'oid :name o)) + (t (make-instance 'oid :name ""))))) + (c-snmp-add-null-var pdu + (slot-value real-o 'c-oids) + (mem-ref (slot-value real-o 'c-oid-len) 'c-size-type)))) ;; 2. get results from response pdu (let ((status (c-snmp-synch-response ss pdu response))) - (setf values - (if (and (= status +snmp-stat-success+) - (= (foreign-slot-value (mem-aref response :pointer) 'c-snmp-pdu 'c-errstat) - +snmp-err-noerror+)) - (loop for vars = (foreign-slot-value (mem-aref response :pointer) - 'c-snmp-pdu 'c-variables) - then (foreign-slot-value vars 'c-variable-list 'c-next-variable) - until (null-pointer-p vars) - collect (snmp-var->value vars))))) + (setf values + (if (and (= status +snmp-stat-success+) + (= (foreign-slot-value (mem-aref response :pointer) 'c-snmp-pdu 'c-errstat) + +snmp-err-noerror+)) + (loop for vars = (foreign-slot-value (mem-aref response :pointer) + 'c-snmp-pdu 'c-variables) + then (foreign-slot-value vars 'c-variable-list 'c-next-variable) + until (null-pointer-p vars) + collect (snmp-var->value vars))))) (c-snmp-pdu-free (mem-aref response :pointer)) (c-snmp-close ss) values))) +#+lispworks +(defmethod snmp-msg-get-list ((s snmp-session) (oids list)) + (let ((ss (snmp-open (slot-value s 'c-session))) + (pdu (snmp-pdu-create +snmp-msg-get+)) + values) + (fli:with-dynamic-foreign-objects ((response (:pointer netsnmp-pdu))) + (progn + ;; 1. fill oids into request pdu + (dolist (o oids) + (let ((real-o (typecase o + (oid o) + (string (make-instance 'oid :name o)) + (t (error "unknown oid type"))))) + (snmp-add-null-var pdu + (slot-value real-o 'c-oids) + (fli:dereference (slot-value real-o 'c-oid-len))))) + ;; 2. get results from response pdu + (let ((status (snmp-synch-response ss pdu response))) + (setf values + (if (and (= status +snmp-stat-success+) + (= (fli:foreign-slot-value (fli:dereference response) 'errstat) + +snmp-err-noerror+)) + (loop for vars = (fli:foreign-slot-value (fli:dereference response) + 'variables) + then (fli:foreign-slot-value vars 'next-variable) + until (fli:null-pointer-p vars) + collect (snmp-var->value vars))))) + (snmp-free-pdu (fli:dereference response)) + (snmp-close ss) + values)))) + (defmethod snmp-msg-get-list ((s string) (oids list)) (snmp-msg-get-list (make-instance 'snmp-session :peername s) oids)) + +#-lispworks +(defun snmp-var->value (v) + (case (foreign-slot-value v 'c-variable-list 'c-type) + ;; ASN_OCTET_STR + (+asn-octet-str+ + (foreign-string-to-lisp + (foreign-slot-value v 'c-variable-list 'c-val) + (foreign-slot-value v 'c-variable-list 'c-val-len))) + ;; ASN_COUNTER + (+asn-counter+ + (mem-ref (foreign-slot-value v 'c-variable-list 'c-val) + :uint32)) + (otherwise :others))) + +#+lispworks +(defun snmp-var->value (v) + (case (fli:foreign-slot-value v 'type) + ;; ASN_INTEGER + (#x02 + (fli:dereference + (fli:foreign-slot-value (fli:foreign-slot-pointer v 'val) + 'integer))) + ;; ASN_OCTET_STR + (#x04 + (fli:convert-from-foreign-string + (fli:foreign-slot-value (fli:foreign-slot-pointer v 'val) + 'string) + :length (fli:foreign-slot-value v 'val-len))) + (otherwise (fli:foreign-slot-value v 'type)))) Added: trunk/lw-dff.lisp ============================================================================== --- (empty file) +++ trunk/lw-dff.lisp Wed May 23 16:08:52 2007 @@ -0,0 +1,33 @@ +(in-package :org.net-snmp) + +(eval-when (:compile-toplevel :load-toplevel) + (fli:define-c-typedef (size-t (:foreign-name "size_t")) + (:unsigned :long)) + (fli:define-c-typedef (u-long (:foreign-name "u_long")) + (:unsigned :long)) + (fli:define-c-typedef (oid (:foreign-name "oid")) u-long) + + (fli:define-foreign-function (init-snmp "init_snmp" :source) + ;; Page 32 of FLI Manual + ((arg-1 (:reference-pass :ef-mb-string))) + :result-type :void + :language :ansi-c) + + (fli:define-foreign-function (read-objid "read_objid" :source) + ((arg-1 (:reference-pass :ef-mb-string)) + (arg-2 (:pointer oid)) + (arg-3 (:pointer size-t))) + :result-type :int + :language :ansi-c) + + (fli:define-foreign-function (get-node "get_node" :source) + ((arg-1 (:reference-pass :ef-mb-string)) + (arg-2 (:pointer oid)) + (arg-3 (:pointer size-t))) + :result-type :int + :language :ansi-c)) + +(eval-when (:load-toplevel) + (init-snmp "snmpapp") + (format t "Net-SNMP Initialized.~%")) + Added: trunk/net-snmp-dff.lisp ============================================================================== --- (empty file) +++ trunk/net-snmp-dff.lisp Wed May 23 16:08:52 2007 @@ -0,0 +1,265 @@ +#| DATE : 24 May 2007 + | USER : binghe + | PROCESSED FILE : net-snmp.h + |# + +(in-package :org.net-snmp) + +;;; Derived from file : "/home/binghe/cl-net-snmp/net-snmp.h" + +(fli:define-c-typedef (u-char (:foreign-name "u_char")) + (:unsigned :char)) +(fli:define-c-typedef (u-short (:foreign-name "u_short")) + (:unsigned :short)) +(fli:define-c-typedef (u-int (:foreign-name "u_int")) (:unsigned :int)) +(fli:define-c-struct (counter64 (:foreign-name "counter64")) + (high u-long) + (low u-long)) +(fli:define-c-struct (variable-list + (:foreign-name "variable_list") + (:forward-reference t))) +(fli:define-c-typedef (netsnmp-variable-list + (:foreign-name "netsnmp_variable_list")) + (:struct variable-list)) +(fli:define-c-struct (netsnmp-transport-s + (:foreign-name "netsnmp_transport_s") + (:forward-reference t))) +(fli:define-c-struct (snmp-pdu (:foreign-name "snmp_pdu")) + (version :long) + (command :int) + (reqid :long) + (msgid :long) + (transid :long) + (sessid :long) + (errstat :long) + (errindex :long) + (time u-long) + (flags u-long) + (security-model :int) + (security-level :int) + (msg-parse-model :int) + (transport-data (:pointer :void)) + (transport-data-length :int) + (t-domain (:pointer (:const oid))) + (t-domain-len size-t) + (variables (:pointer netsnmp-variable-list)) + (community (:pointer u-char)) + (community-len size-t) + (enterprise (:pointer oid)) + (enterprise-length size-t) + (trap-type :long) + (specific-type :long) + (agent-addr (:c-array (:unsigned :char) 4)) + (context-engine-id (:pointer u-char)) + (context-engine-idlen size-t) + (context-name (:pointer :char)) + (context-name-len size-t) + (security-engine-id (:pointer u-char)) + (security-engine-idlen size-t) + (security-name (:pointer :char)) + (security-name-len size-t) + (priority :int) + (range-subid :int) + (security-state-ref (:pointer :void))) +(fli:define-c-typedef (netsnmp-pdu (:foreign-name "netsnmp_pdu")) + (:struct snmp-pdu)) +(fli:define-c-struct (snmp-session + (:foreign-name "snmp_session") + (:forward-reference t))) +(fli:define-c-typedef (netsnmp-session + (:foreign-name "netsnmp_session")) + (:struct snmp-session)) +(fli:define-c-typedef (snmp-callback (:foreign-name "snmp_callback")) + (:pointer + (:function + (:int + (:pointer netsnmp-session) + :int + (:pointer netsnmp-pdu) + (:pointer :void)) + :int))) +(fli:define-c-typedef (netsnmp-callback + (:foreign-name "netsnmp_callback")) + (:pointer + (:function + (:int + (:pointer netsnmp-session) + :int + (:pointer netsnmp-pdu) + (:pointer :void)) + :int))) +(fli:define-c-struct (snmp-session (:foreign-name "snmp_session")) + (version :long) + (retries :int) + (timeout :long) + (flags u-long) + (subsession (:pointer (:struct snmp-session))) + (next (:pointer (:struct snmp-session))) + (peername (:pointer :char)) + (remote-port u-short) + (localname (:pointer :char)) + (local-port u-short) + (authenticator + (:pointer + (:function + ((:pointer u-char) + (:pointer size-t) + (:pointer u-char) + size-t) + (:pointer u-char)))) + (callback netsnmp-callback) + (callback-magic (:pointer :void)) + (s-errno :int) + (s-snmp-errno :int) + (sessid :long) + (community (:pointer u-char)) + (community-len size-t) + (rcv-msg-max-size size-t) + (snd-msg-max-size size-t) + (is-authoritative u-char) + (context-engine-id (:pointer u-char)) + (context-engine-idlen size-t) + (engine-boots u-int) + (engine-time u-int) + (context-name (:pointer :char)) + (context-name-len size-t) + (security-engine-id (:pointer u-char)) + (security-engine-idlen size-t) + (security-name (:pointer :char)) + (security-name-len size-t) + (security-auth-proto (:pointer oid)) + (security-auth-proto-len size-t) + (security-auth-key (:c-array u-char 32)) + (security-auth-key-len size-t) + (security-auth-local-key (:pointer u-char)) + (security-auth-local-key-len size-t) + (security-priv-proto (:pointer oid)) + (security-priv-proto-len size-t) + (security-priv-key (:c-array u-char 32)) + (security-priv-key-len size-t) + (security-priv-local-key (:pointer u-char)) + (security-priv-local-key-len size-t) + (security-model :int) + (security-level :int) + (security-info (:pointer :void)) + (myvoid (:pointer :void))) +(fli:define-c-typedef (netsnmp-vardata + (:foreign-name "netsnmp_vardata")) + (:union + (integer (:pointer :long)) + (string (:pointer u-char)) + (objid (:pointer oid)) + (bitstring (:pointer u-char)) + (counter64 (:pointer (:struct counter64))))) +(fli:define-c-struct (variable-list (:foreign-name "variable_list")) + (next-variable (:pointer (:struct variable-list))) + (name (:pointer oid)) + (name-length size-t) + (type u-char) + (val netsnmp-vardata) + (val-len size-t) + (name-loc (:c-array oid 128)) + (buf (:c-array u-char 40)) + (data (:pointer :void)) + (data-free-hook + (:pointer (:function ((:pointer :void)) :void))) + (index :int)) +(fli:define-foreign-function (snmp-sess-init "snmp_sess_init" :source) + ((arg-1 (:pointer netsnmp-session))) + :result-type + :void + :language + :ansi-c) +(fli:define-foreign-function (snmp-open "snmp_open" :source) + ((arg-1 (:pointer netsnmp-session))) + :result-type + (:pointer netsnmp-session) + :language + :ansi-c) +(fli:define-foreign-function (snmp-close "snmp_close" :source) + ((arg-1 (:pointer netsnmp-session))) + :result-type + :int + :language + :ansi-c) +(fli:define-foreign-function (snmp-close-sessions + "snmp_close_sessions" + :source) + nil + :result-type + :int + :language + :ansi-c) +(fli:define-foreign-function (snmp-perror "snmp_perror" :source) + ((arg-1 (:pointer (:const :char)))) + :result-type + :void + :language + :ansi-c) +(fli:define-foreign-function (snmp-errstring "snmp_errstring" :source) + ((arg-1 :int)) + :result-type + (:pointer (:const :char)) + :language + :ansi-c) +(fli:define-foreign-function (snmp-sess-perror + "snmp_sess_perror" + :source) + ((prog-string (:pointer (:const :char))) + (ss (:pointer netsnmp-session))) + :result-type + :void + :language + :ansi-c) +(fli:define-foreign-function (snmp-pdu-create + "snmp_pdu_create" + :source) + ((arg-1 :int)) + :result-type + (:pointer netsnmp-pdu) + :language + :ansi-c) +(fli:define-foreign-function (snmp-free-pdu "snmp_free_pdu" :source) + ((arg-1 (:pointer netsnmp-pdu))) + :result-type + :void + :language + :ansi-c) +(fli:define-foreign-function (snmp-pdu-type "snmp_pdu_type" :source) + ((type :int)) + :result-type + (:pointer (:const :char)) + :language + :ansi-c) +(fli:define-foreign-function (snmp-add-null-var + "snmp_add_null_var" + :source) + ((arg-1 (:pointer netsnmp-pdu)) + (arg-2 (:pointer (:const oid))) + (arg-3 size-t)) + :result-type + (:pointer netsnmp-variable-list) + :language + :ansi-c) +(fli:define-foreign-function (snmp-synch-response + "snmp_synch_response" + :source) + ((arg-1 (:pointer netsnmp-session)) + (arg-2 (:pointer netsnmp-pdu)) + (arg-3 + (:pointer (:pointer netsnmp-pdu)))) + :result-type + :int + :language + :ansi-c) +(fli:define-foreign-function (generate-ku "generate_Ku" :source) + ((hashtype (:pointer (:const oid))) + (hashtype-len u-int) + (p (:pointer u-char)) + (pplen size-t) + (ku (:pointer u-char)) + (kulen (:pointer size-t))) + :result-type + :int + :language + :ansi-c) Modified: trunk/net-snmp.asd ============================================================================== --- trunk/net-snmp.asd (original) +++ trunk/net-snmp.asd Wed May 23 16:08:52 2007 @@ -2,17 +2,22 @@ (defpackage :net-snmp-system (:use :cl :asdf)) - + (in-package :net-snmp-system) + +;;(require "foreign-parser") +;;(foreign-parser:process-foreign-file "net-snmp.h" :case-sensitive :split-name) (defsystem net-snmp :description "Common Lisp interface for Net-SNMP" - :version "0.10" + :version "0.50" :author "Chun Tian (binghe)" - :depends-on (:cffi) + ;;:depends-on (:cffi) :components ((:file "package") (:file "constants" :depends-on ("package")) - (:file "typedefs" :depends-on ("constants")) - (:file "asn1" :depends-on ("typedefs")) - (:file "snmp-api" :depends-on ("constants" "typedefs")) - (:file "classes" :depends-on ("snmp-api")))) + #-lispworks (:file "typedefs" :depends-on ("constants")) + #+lispworks (:file "lw-dff" :depends-on ("package")) + #+lispworks (:file "net-snmp-dff" :depends-on ("package")) + #-lispworks (:file "snmp-api" :depends-on ("constants" "typedefs")) + (:file "asn1" :depends-on (#-lispworks "typedefs" #+lispworks "net-snmp-dff")))) + ;;(:file "classes" :depends-on ("snmp-api")))) Added: trunk/net-snmp.h ============================================================================== --- (empty file) +++ trunk/net-snmp.h Wed May 23 16:08:52 2007 @@ -0,0 +1,309 @@ +typedef unsigned char u_char; +typedef unsigned short u_short; +typedef unsigned int u_int; + +struct counter64 { + u_long high; + u_long low; +}; + +struct variable_list; +typedef struct variable_list netsnmp_variable_list; +struct netsnmp_transport_s; + +#define USM_AUTH_KU_LEN 32 +#define USM_PRIV_KU_LEN 32 +#define MIN_OID_LEN 2 +#define MAX_OID_LEN 128 /* max subid's in an oid */ + +/** @typedef struct snmp_pdu to netsnmp_pdu + * Typedefs the snmp_pdu struct into netsnmp_pdu */ +/** @struct snmp_pdu + * The snmp protocol data unit. + */ +typedef struct snmp_pdu { + + /* + * Protocol-version independent fields + */ + /** snmp version */ + long version; + /** Type of this PDU */ + int command; + /** Request id - note: not incremented on retries */ + long reqid; + /** Message id for V3 messages note: incremented for each retry */ + long msgid; + /** Unique ID for incoming transactions */ + long transid; + /** Session id for AgentX messages */ + long sessid; + /** Error status (non_repeaters in GetBulk) */ + long errstat; + /** Error index (max_repetitions in GetBulk) */ + long errindex; + /** Uptime */ + u_long time; + u_long flags; + + int securityModel; + /** noAuthNoPriv, authNoPriv, authPriv */ + int securityLevel; + int msgParseModel; + + /** + * Transport-specific opaque data. This replaces the IP-centric address + * field. + */ + + void *transport_data; + int transport_data_length; + + /** + * The actual transport domain. This SHOULD NOT BE FREE()D. + */ + + const oid *tDomain; + size_t tDomainLen; + + netsnmp_variable_list *variables; + + + /* + * SNMPv1 & SNMPv2c fields + */ + /** community for outgoing requests. */ + u_char *community; + /** length of community name. */ + size_t community_len; + + /* + * Trap information + */ + /** System OID */ + oid *enterprise; + size_t enterprise_length; + /** trap type */ + long trap_type; + /** specific type */ + long specific_type; + /** This is ONLY used for v1 TRAPs */ + unsigned char agent_addr[4]; + + /* + * SNMPv3 fields + */ + /** context snmpEngineID */ + u_char *contextEngineID; + /** Length of contextEngineID */ + size_t contextEngineIDLen; + /** authoritative contextName */ + char *contextName; + /** Length of contextName */ + size_t contextNameLen; + /** authoritative snmpEngineID for security */ + u_char *securityEngineID; + /** Length of securityEngineID */ + size_t securityEngineIDLen; + /** on behalf of this principal */ + char *securityName; + /** Length of securityName. */ + size_t securityNameLen; + + /* + * AgentX fields + * (also uses SNMPv1 community field) + */ + int priority; + int range_subid; + + void *securityStateRef; +} netsnmp_pdu; + +struct snmp_session; + +/** @typedef struct snmp_session netsnmp_session + * Typedefs the snmp_session struct intonetsnmp_session */ +typedef struct snmp_session netsnmp_session; + +typedef int (*snmp_callback) (int, netsnmp_session *, int, + netsnmp_pdu *, void *); +typedef int (*netsnmp_callback) (int, netsnmp_session *, int, + netsnmp_pdu *, void *); + +/** @struct snmp_session + * The snmp session structure. + */ +struct snmp_session { + /* + * Protocol-version independent fields + */ + /** snmp version */ + long version; + /** Number of retries before timeout. */ + int retries; + /** Number of uS until first timeout, then exponential backoff */ + long timeout; + u_long flags; + struct snmp_session *subsession; + struct snmp_session *next; + + /** Domain name or dotted IP address of default peer */ + char *peername; + /** UDP port number of peer. */ + u_short remote_port; + /** My Domain name or dotted IP address, 0 for default */ + char *localname; + /** My UDP port number, 0 for default, picked randomly */ + u_short local_port; + /** + * Authentication function or NULL if null authentication is used + */ + u_char *(*authenticator) (u_char *, size_t *, u_char *, size_t); + /** Function to interpret incoming data */ + netsnmp_callback callback; + /** + * Pointer to data that the callback function may consider important + */ + void *callback_magic; + /** copy of system errno */ + int s_errno; + /** copy of library errno */ + int s_snmp_errno; + /** Session id - AgentX only */ + long sessid; + + /* + * SNMPv1 & SNMPv2c fields + */ + /** community for outgoing requests. */ + u_char *community; + /** Length of community name. */ + size_t community_len; + /** Largest message to try to receive. */ + size_t rcvMsgMaxSize; + /** Largest message to try to send. */ + size_t sndMsgMaxSize; + + /* + * SNMPv3 fields + */ + /** are we the authoritative engine? */ + u_char isAuthoritative; + /** authoritative snmpEngineID */ + u_char *contextEngineID; + /** Length of contextEngineID */ + size_t contextEngineIDLen; + /** initial engineBoots for remote engine */ + u_int engineBoots; + /** initial engineTime for remote engine */ + u_int engineTime; + /** authoritative contextName */ + char *contextName; + /** Length of contextName */ + size_t contextNameLen; + /** authoritative snmpEngineID */ + u_char *securityEngineID; + /** Length of contextEngineID */ + size_t securityEngineIDLen; + /** on behalf of this principal */ + char *securityName; + /** Length of securityName. */ + size_t securityNameLen; + + /** auth protocol oid */ + oid *securityAuthProto; + /** Length of auth protocol oid */ + size_t securityAuthProtoLen; + /** Ku for auth protocol XXX */ + u_char securityAuthKey[USM_AUTH_KU_LEN]; + /** Length of Ku for auth protocol */ + size_t securityAuthKeyLen; + /** Kul for auth protocol */ + u_char *securityAuthLocalKey; + /** Length of Kul for auth protocol XXX */ + size_t securityAuthLocalKeyLen; + + /** priv protocol oid */ + oid *securityPrivProto; + /** Length of priv protocol oid */ + size_t securityPrivProtoLen; + /** Ku for privacy protocol XXX */ + u_char securityPrivKey[USM_PRIV_KU_LEN]; + /** Length of Ku for priv protocol */ + size_t securityPrivKeyLen; + /** Kul for priv protocol */ + u_char *securityPrivLocalKey; + /** Length of Kul for priv protocol XXX */ + size_t securityPrivLocalKeyLen; + + /** snmp security model, v1, v2c, usm */ + int securityModel; + /** noAuthNoPriv, authNoPriv, authPriv */ + int securityLevel; + + /** + * security module specific + */ + void *securityInfo; + + /** + * use as you want data + */ + void *myvoid; +}; + +typedef union { + long *integer; + u_char *string; + oid *objid; + u_char *bitstring; + struct counter64 *counter64; +} netsnmp_vardata; + +/** @struct variable_list + * The netsnmp variable list binding structure, it's typedef'd to + * netsnmp_variable_list. + */ +struct variable_list { + /** NULL for last variable */ + struct variable_list *next_variable; + /** Object identifier of variable */ + oid *name; + /** number of subid's in name */ + size_t name_length; + /** ASN type of variable */ + u_char type; + /** value of variable */ + netsnmp_vardata val; + /** the length of the value to be copied into buf */ + size_t val_len; + /** 90 percentile < 24. */ + oid name_loc[MAX_OID_LEN]; + /** 90 percentile < 40. */ + u_char buf[40]; + /** (Opaque) hook for additional data */ + void *data; + /** callback to free above */ + void (*dataFreeHook)(void *); + int index; +}; + +void snmp_sess_init(netsnmp_session *); +netsnmp_session *snmp_open(netsnmp_session *); +int snmp_close(netsnmp_session *); +int snmp_close_sessions(void); +extern void snmp_perror(const char *); +const char *snmp_errstring(int); +void snmp_sess_perror(const char *prog_string, + netsnmp_session * ss); +netsnmp_pdu *snmp_pdu_create(int); +void snmp_free_pdu(netsnmp_pdu *); +const char * snmp_pdu_type(int type); +int get_node(const char *, oid *, size_t *); +netsnmp_variable_list *snmp_add_null_var(netsnmp_pdu *, const oid *, size_t); +int snmp_synch_response(netsnmp_session *, netsnmp_pdu *, + netsnmp_pdu **); +int generate_Ku(const oid * hashtype, u_int hashtype_len, + u_char * P, size_t pplen, + u_char * Ku, size_t * kulen); Modified: trunk/package.lisp ============================================================================== --- trunk/package.lisp (original) +++ trunk/package.lisp Wed May 23 16:08:52 2007 @@ -2,7 +2,7 @@ (defpackage :org.net-snmp (:nicknames :snmp) - (:use :cl :cffi) + (:use :cl #-lispworks :cffi) (:export ;; class snmp-session oid @@ -16,14 +16,13 @@ (in-package :org.net-snmp) -(eval-when (:compile-toplevel :load-toplevel :execute) - (define-foreign-library libssl - (:unix (:or "libssl.so.0.9.8" "libssl.so")) - (t (:default "libssl"))) - +#-lispworks +(eval-when (:compile-toplevel :load-toplevel) (define-foreign-library libsnmp - (:unix (:or "libsnmp.so.15" "libsnmp.so")) + (:unix "libsnmp.so.9") (t (:default "libsnmp"))) - - (use-foreign-library libssl) (use-foreign-library libsnmp)) + +#+lispworks +(eval-when (:compile-toplevel :load-toplevel) + (fli:register-module "libsnmp.so.9"))

1 0

[cl-net-snmp-cvs] r15 - trunk
by ctian＠common-lisp.net 10 Apr '07

10 Apr '07

Author: ctian Date: Tue Apr 10 18:59:45 2007 New Revision: 15 Modified: trunk/typedefs.lisp Log: size-type should use ulong? Modified: trunk/typedefs.lisp ============================================================================== --- trunk/typedefs.lisp (original) +++ trunk/typedefs.lisp Tue Apr 10 18:59:45 2007 @@ -1,6 +1,6 @@ (in-package :org.net-snmp) -(defctype c-size-type :long) +(defctype c-size-type :ulong) (defcstruct c-snmp-pdu "The snmp protocol data unit."

1 0