base64

 　Base64は主にWindowsPCで画像などのバイナリデータを電子メールで送信するときに使われるエンコード形式で、 (電子メールでは8ビット目を持つキャラクターを受送信できないため) 7ビットの可読ASCII文字の並びで表されます。 base64パッケージは任意のTcl文字列をBase64形式に変換(エンコード) したりBase64形式から元の文字列に変換(デコード)したりする機能を提供します。 またTcl/Tkでは、画像データをTclスクリプトの中に「埋め込む」 ことができますが、そのときに使われるコードがこのBase64です。 下の例は画像ファイルを読み、Base64形式に変換して「埋め込んだ」 Tclスクリプトを出力するTclスクリプトです。 スクリプトを出力するスクリプト？ や、ややこしいなあー。 ムッチャ説明しづらいのでとりあえず、wishで下のコードを実行してみてくださいね。 

package require base64
set targetFileName "C:/progra~1/tcl/lib/tk8.3/images/pwrdLogo100.gif"
set tempFileName   "tmptmp.tcl"

fconfigure [set fin [open $targetFileName r]] -translation binary
set buf [read $fin]
close $fin

set encoded_buf [base64::encode -maxlen 60 -wrapchar "\\\n" $buf]

set fout [open $tempFileName w]
puts $fout \
  "set data {$encoded_buf}\n\
   image create photo Image1 -data \$data\n\
   button .cmda -image Image1 -command exit\n\
   pack .cmda\n\
  "
close $fout
puts "wrote. [file size $tempFileName] bytes. reading..."
source $tempFileName
# end.

　base64パッケージの使い方はとても簡単、エンコードを行う base64::encodeコマンドとデコードを行う base64::decodeコマンドがあるだけです。 base64::encodeの-wrapcharは各行の区切り文字列を、 -maxlenは何文字毎に区切り文字列を入れるかを指定します。 -wrapcharのデフォルトは "\n" つまり区切られる度に改行します。


mimeとsmtp

 　mimeとsmtpはTcllibの「mime」サブディレクトリに一体化して存在します。 これらは任意のTcl文字列やファイルからメッセージを作り、 SMTP(Simple Mail Transfer Protocol) を使って電子メールを送信する機能を提供します。 日本語の扱いについて配慮が必要なのでオクシデンタルな文化圏の人びとに比べてちょっと使い方が難しいですが、 MUA（メーラー）でメールを出すのと同じように、 無難にメールが送信できます。イントラで動くツールから管理メールを送信しよう、 などという用途にバッチグー(死語)です。 

package require mime
package require smtp

set textmessage \
{テストメールを送信します。
This is a test mail.
------------------------------------------------------
}

proc sendTextMessage {textmessage} {
  set sendable [encoding convertto iso2022-jp $textmessage]

  set part [mime::initialize \
    -canonical "text/plain; charset=iso-2022-jp" -string $sendable]

  set r [smtp::sendmessage $part \
    -servers noar13.center.nsnhnkmmkk.co.jp \
    -ports 25 \
    -header [list From "Web Admin<wadm@nsnhnkmmkk.co.jp>"] \
    -header [list To   "Misumi Urano<uranom@nsnhnkmmkk.co.jp>"] \
    -header [list Subject "Test Message"] \
  ]
  puts "done. result: $r"
}
sendTextMessage $textmessage
# end.

　Tclスクリプトの中で文字列を組み立てる方法でも、 既にあるファイルの内容をそのまま送る方法でも、簡単にメールが送信できます。 英語のアルファベットだけからなるメッセージを送信する場合は、 次の手順でＯＫです。

  1. mime::initializeコマンドでTcl文字列またはファイルからMIMEメッセージを作ります。
  2. smtp::sendmessageコマンドでSMTPメールサーバーに向けてメールを送信します。
SMTPメールサーバーというのは、sendmailなどのメーラーデーモン(MTA) が動いているサーバー機のことです。 Tcl/Tkスクリプトを動かしているマシン自体がメールサーバーだという (一般には)不自然な場合を除いて、 smtp::sendmessageコマンドでは必ず -serversオプションでSMTPメールサーバーのホスト名(複数あればホスト名のリスト) を、-portsオプションでポート番号を指定します。 ポート番号のデフォルトは25で、これすなわちSMTPのデフォルトポートなので、 普通-portsは省略できます。

　はてさてところで、上の1, 2の通りにしただけでは、 日本語を含むメッセージは文字化けしてしまいます。 日本語を正しく扱わせるには、次の2点に注意する必要があります(*1)。

  • 日本語はencoding converttoサブコマンドを使って 「iso2022-jp」エンコーディングに変換します。
  • mime::initializeコマンドの-canonicalオプションには 「Content-Type」の値として 「text/plain; charset=iso-2022-jp」を必ず指定します。 デフォルトは「text/plain; charset="us-ascii"」 がContent-Typeとしてつけられるので、 この状態で日本語を使うと化けてしまいます。

　上のスクリプトを応用して、 イントラで使える簡単な報告メールを送るスクリプトを作ってみました。 コマンドラインで指定したテキストファイルを、 スクリプト内固定のメールアドレスに送信します。 テキストファイルは日本語EUCコードで書かれていることを想定していますが、 ちょっと変えればシフトJISコードのテキストファイルにも対応できますね。 

#! /usr/local/bin/tclsh
package require mime
package require smtp
set filename [lindex $argv 0]
if {"$filename" == ""} {
  puts stderr "usage: $argv0 filename"; exit 1
}
proc sendTextFile {filename encoding} {
  set fin [open $filename r]
  fconfigure $fin -encoding $encoding
  set buf [read $fin]
  close $fin

  set sendable "\n[encoding convertto iso2022-jp $buf]"
  set part [mime::initialize \
            -canonical "text/plain; charset=iso-2022-jp" \
            -string $sendable]
  set r [smtp::sendmessage $part \
      -servers noar13.center.nsnhnkmmkk.co.jp -ports 25 \
      -header [list From "Web Adaministrator <wadm@nsnhnkmmkk.co.jp>"] \
      -header [list To   "uranom@nsnhnkmmkk.co.jp"] \
      -header [list Subject "SYSTEM REPORT"] ]
}
sendTextFile $filename euc-jp
# end.

　今度は画像や音声などのバイナリファイルを送信するために、 BASE64エンコードをかけたメールを出してみます。 

package require smtp
package require mime
set server    "noar13.nsnknkmmkk.co.jp"
set from      "Misumi Urano <urano398@nsnknkmmkk.co.jp>"
set to        "Kenichi Ushirodani <usrodani@nsnknkmmkk.co.jp>"
set subject   "Deaikei Party no Photo"
set imageFile "/sub/test.gif"
set tail [file tail $imageFile]
set part [mime::initialize -canonical "image/gif" \
  -encoding base64 -file $imageFile \
  -param [list "Content-Disposition" "attachment; filename=$tail"]]
set r [smtp::sendmessage $part -servers $server -ports 25 \
      -header [list From "$from"] -header [list To "$to"] \
      -header [list Subject "$subject"] ]

バイナリデータを送るとき、それが既にファイルになっているのであれば (バイナリデータをTclスクリプト中で生成するのでなければ)、 mime::initializeコマンドの -fileでそのファイルを、-encodingで「base64」を指定するだけでOKです。 (サンプル中の「Content-Disposition:」は添付ファイルにしたときにファイル名を示すために使うものらしいのですが、私のMUAでは効き目がありませんでした) とりあえずこれを送ると、本文が全くなく、 バイナリデータが添付されたものが相手に届くと思います。

　これを応用して、最後にマルチパート (いわゆる「添付ファイル」つき)のメールを出してみましょう。 

package require smtp
package require mime
set server    "noar13.nsnknkmmkk.co.jp"
set from      "Misumi Urano <urano398@nsnknkmmkk.co.jp>"
set to        "Kenichi Ushirodani <usrodani@nsnknkmmkk.co.jp>"
set subject   "Deaikei Party no Oshirase"
set textmessage \
"テストメールを送信します。\n\
This is a test mail.\n\
------------------------------------------------------\n"
set imageFile "/sub/test.gif"

# テキストのMIMEパート
set sendable [encoding convertto iso2022-jp $textmessage]
set Tpart [mime::initialize \
           -canonical "text/plain; charset=iso-2022-jp" -string $sendable]

# 画像データのMIMEパート
set tail [file tail $imageFile]
set Ipart [mime::initialize -canonical "image/gif" \
  -encoding base64 -file $imageFile \
  -param [list "Content-Disposition" "attachment; filename=$tail"]]

# マルチパートを作る
set Mpart [mime::initialize -canonical multipart/mixed \
           -parts [list $Tpart $Ipart]]
# 送信！
set r [smtp::sendmessage $Mpart \
      -servers $server -ports 25 -header [list From "$from"] \
      -header [list To "$to"] -header [list Subject "$subject"] ]
# あとしまつ
mime::finalize $Mpart

マルチパートのメールを作るには、まずそれぞれのパートを mime::initializeで固めておき、 最後にmime::initializeで 「-canonical multipart/mixed」をもつパートを作り、これを送信します。

(*1)これはあくまで本サイトで確認した環境 (MTA、MUA)でのことです。 メールが相手に届くまでに経由するMTAやメールを受け取る相手のMUAが幾つかの規約を実装していなかったり破っていたりする場合には、 これ以外の配慮が必要になったりいらなかったりする可能性があります。

　というわけなのですがいかがでしょう。 まずまずこれで日本語のメールも送信できることが確認できたわけですが、 難点があって、 Tcllibが出すエラーメッセージが非常にわかりにくいのです。 Tcllibでメールを出すプログラムを作るときには、 通常のMUAも用意して、突然不可解なエラーメッセージが出るようになったときには、 スクリプトの記述ミスなのか、 メールサーバーの応答がちゃんとできていないのかを早めに切り分けないと、 延々悩むことにもなりかねません。 その辺りも勘案すると、 ホームユースでプロバイダのメールサーバーとの間で使うツールよりも、 専らイントラで使うツールの開発に使うのが望ましいといえましょう。


pop3

 　さて、送る神あれば受け取る神あり(?)というわけで、今度は電子メールの受信側です。 pop3パッケージはPOP3(Post Office Protocol) というプロトコルによってPOPサーバーからメールを受信したり、 受信したメールをPOPサーバー上から消去したりする機能を持っています。 

package require pop3

set popserver "falcon.center.nsnhnkmmkk.co.jp"
set user      "uranom"
set password  "urano398"

set con [pop3::open $popserver $user $password 110]
set r [pop3::status $con]
puts "[lindex $r 0] 通のメール ([lindex $r 1] バイト) が来ています。"

puts "最初の1通を読むなりよ。"
set message [lindex [pop3::retrieve $con 1 1] 0]
puts [encoding convertfrom iso2022-jp $message]
pop3::close $con
# end.

　順を追うと、次のようになります：

  1. まず、pop3::openでPOPサーバーにログインします。 このコマンドは4つの引数をとり、それぞれPOPサーバーのアドレス、 ユーザーアカウント名、パスワード、POPのポート番号です。 最後のポート番号は省略すると110、つまりPOPのデフォルトポートが使われます。 パスワードをべたで指定しますので、 安全にはくれぐれも気をつけてくださいね。 pop3::openはPOPサーバーに接続したソケットハンドルを返します。 以後のコマンドではこの値を引数に使用します。
  2. pop3::statusを使うと、 {貯まっているメッセージ数 使用スプールの総サイズ} というリストを返してきます。 ここで現在貯まっているメッセージの数が分かります。後者は特に使い道はないでしょう。
  3. pop3::retrieveを使い、 メールを受信します。引数は受信したいメールの範囲の最初の番号(先頭が1) と最後の番号です。どの番号まで見ればいいのかを示すのが、 上のpop3::statusの戻り値のリストの最初の要素です。 pop3::retrieveコマンドの戻り値は、 各番号のメールの内容を文字列(正確にはバイト列のオブジェクト)とするTclリストです。 読みたい本文が1通だけでもリストになって返ってくる点に注意して下さい。 必ずlindexで取り出さないと、後述のencoding convertfromコマンドでうまく変換ができず、 文字化けしてしまいます。
  4. 思う存分受信し終わったら、 最後にpop3::closeコマンドで接続を切れば処理は完了です。

　なお、この方法でメッセージを受け取っても、POPサーバーの中からはメッセージは消去されません。サーバー上のメッセージを消すには、 pop3::deleteというコマンドを使う必要があります。

　また、日本語のメッセージを受け取る場合ですが、 POPサーバーは日本語をiso2022-jp(いわゆるJISコード) で返してきます。従って、Tcl世界の文字コードUTF-8に変換をかけるために encodingを使う必要があります。 

set buf  [encoding convertfrom iso2022-jp $buf]


ftp

 　ftpパッケージは、インターネットで非常にポピュラーなプロトコルのひとつ FTP(File Transfer Protocol)を使って遠隔計算機とファイルを受送信するコマンドを提供します。 下のサンプルに示す通り、使い方はとても簡単です。おおまかな流れはこのようになります。

  1. ftp::Openコマンドで相手の遠隔計算機にログインします。
  2. ftp::Typeコマンドでアスキー転送モード、 バイナリ転送モードのどちらかを指定します。
  3. ftp::Cdコマンドでディレクトリを移動します。
  4. ftp::NListコマンドでファイル名の一覧を Tclリストとして受け取ります。 ftp::Listコマンドはftpで"dir"コマンドを使ったときのような応答が得られますが、 日本語が入ると化けてしまうという欠点があるので、NListを使うとよいでしょう。
  5. あとはftp::Getで向こうからこっちに、 ftp::Putでこっちから向こうに、ファイルを転送することができます。
  6. 最後にftp::Closeで接続を切ります。
というわけで、FTPの処理の流れに沿って忠実に実行していけばOKということですね。 ちなみにFTPサーバへの接続に失敗すると ftp::Openコマンドは-1を返します。
なお、リモート側のファイルのサイズを得るftp::fileSizeというコマンドもありますが、 FTPのSIZEコマンドをサポートしていないサーバが相手の場合は、このコマンドは空文字列を返してきます。

　さて、下のプログラムは私が本当にイントラで使っているツールで、 別の部門のサーバ機にユーザがSambaの共有フォルダ機能を使ってアップロードする *.txt または *.dat というテキストファイルを取得して、 センターサーバであるローカル側の決まったディレクトリに格納するスクリプトです。 cronやatで蹴るとか、OASのようなアプリケーションサーバから蹴るとか、 イントラだといろいろ応用が効きます。 バックアップなど毎日の雑用を自動化するのにぴったりのこまわりくんが作れると思います。 

package require ftp
fconfigure stdout -encoding shiftjis

set REMOTEHOST kikaku.keiei.nsnhnkmmkk.co.jp
set USER       kauser
set PASSWORD   keiei
set REMOTEDIR  /export/home5/keiei/euc/Toukei

# FTPで経営部サーバに接続
set con [::ftp::Open $REMOTEHOST $USER $PASSWORD]
::ftp::Type $con binary

# ファイルの一覧を取得
::ftp::Cd $con $REMOTEDIR
set files [::ftp::NList $con]

# .datまたは.txtのファイルについて、ローカルにコピーします。
foreach e $files {
  if {[regexp {\.(da|tx)t$} [string tolower $e]]} {
    puts "$e を受信しています…"
    ::ftp::Get $con $e
    puts "$e を受信しました。([file size $e] bytes)"
  }
}
::ftp::Close $con
# end.

以下の例は、業務システムのバッチ処理で実際に使っている、 リトライ機能つきのファイル送信スクリプトです。 わけあってFTPサーバがWindows NT ServerのIISなんですが、 ときおりNT上で動いているサーバーアプリケーションの挙動と衝突して、 書き込み不能のエラーでFTPに失敗することがあります。 そこで、失敗したら何回かリトライし、それでも失敗したらステータス1で異常終了するようにしています。 

#!/bin/sh
# the next line restarts using tclsh \
exec tclsh "$0" "$@"
#
# 汎用ファイル送信ツール
# tcllibのftpパッケージを使って、ファイルをリモートサーバに送信します。
# リトライ機能がついています。
#
# 2003/07/14
#
package require ftp
#fconfigure stdout -encoding shiftjis

set ::ftp::VERBOSE 0
set ::ftp::DEBUG   0

# ファイルを送信します。
# 引数：
# sendFile ?options? hostname account password filename
# オプション：
# -d remotedir リモートディレクトリを指定します。
# -ld localdir ローカルディレクトリ(送信元ファイルのあるディレクトリ)
#     を指定します。これが指定されると、そのディレクトリがカレントディレクトリ
#     になります。
# -remotefile filename リモートファイル名を指定します。パスは指定できません。
# -retry n             リトライ回数を指定します。デフォルトは3です。
# -retrysleep n        リトライ間隔を秒で指定します。デフォルトは3(秒)です。
#
# 戻り値：
# 正常終了なら1、エラーなら0を返します。
#
# 特記：
# FTPサーバのポートは指定できません。
#
proc sendFile args {
    set hostname {}
    set account {}
    set password {}
    set localfile {}
    set remotefile {}
    set retry 3
    set retrysleep 3
    set remotedir {}

    for {set i 0} {$i < [llength $args]} {incr i} {
        set arg [lindex $args $i]
        if {! [string compare $arg "-d"]} {
            incr i
            set remotedir [lindex $args $i]
        } elseif {! [string compare $arg "-ld"]} {
            incr i
            cd [lindex $args $i]
        } elseif {! [string compare $arg "-remotefile"]} {
            incr i
            set remotefile [lindex $args $i]
        } elseif {! [string compare $arg "-retry"]} {
            incr i
            set retry [expr [lindex $args $i]+0]
        } elseif {! [string compare $arg "-retrysleep"]} {
            incr i
            set retrysleep [expr [lindex $args $i]+0]]
        } elseif {$hostname == ""} {
            set hostname $arg
        } elseif {$account == ""} {
            set account $arg
        } elseif {$password == ""} {
            set password $arg
        } elseif {$localfile == ""} {
            set localfile $arg
        }
    }
    if {$localfile == ""} {
        error "invalid number of arguments, usage: sendFile ?options? hostname account password localfile"
    }
    if {$remotefile == ""} {
        set remotefile $localfile
    }

    puts "接続しています。$hostname $account/$password ..."
    set con [::ftp::Open $hostname $account $password]
    if {$con == -1} {
        puts "接続できません。"
        return 0
    }
    puts "接続されました。Connection ID=$con"
    ::ftp::Type $con binary

    # リモートディレクトリを移動します。
    if {$remotedir != ""} {
        ::ftp::Cd $con $remotedir
    }
    # set files [::ftp::NList $con]
    # puts $files

    set result 0

    for {set n 0} {$n < $retry} {incr n} {
        set r [::ftp::Put $con $localfile $remotefile]
        if {$r == 1} {
            set localfsz  [file size $localfile]
            set remotefsz [::ftp::FileSize $con $remotefile]
            if {$localfsz == $remotefsz} {
                # FTP転送が成功し、かつファイルサイズが同じであれば
                # 成功とみなし、ブレーク
                puts "ok, transfer completed successfully."
                set result 1; break
            }
        }
        # 失敗したのでリトライ
        puts "ftp failed! sleeping ... [expr $n + 1]"
        after [expr $retrysleep * 1000]
        puts "retrying ... [expr $n + 1]"
    }

    if {$result == 1} {
        puts "ok."
    } else {
        puts "error."
    }

    ::ftp::Close $con
    return $result
}

# test
sendFile -d /doc localhost urano password hello.txt
# end.

本題と全く関係ないですが、fconfigureコマンドでstdoutのエンコーディングをシフトJISにしています。 またおまけだらけなので最後もおまけで締めるわけですが(なんじゃ、そりは)、 変数::ftp::DEBUGや::ftp::VERBOSE に1をセットしておくと、接続中のいろいろなメッセージが表示されます。

●サーバーのログをとってきてPCで見る
もうひとつ、これが実用的か？ と聞かれたら、私が便利なので実用的と言えなくもないと断言せざるを得ないわけにはいかないと言うことも辞さないことはないわけですが、 J2EE(Java2 Enterprise Edition)に基づくWebアプリケーションを配信できるオープンソースのWebサーバ、 Jakarta TomcatのログファイルをサーバからFTPでPCの一時ディレクトリC:\TEMPに取って来て、 PCのテキストエディタで見よう、というプログラムです。 

package require ftp

set ::ftp::VERBOSE 1
set ::ftp::DEBUG   1

set REMOTEHOST falcon.center.nsnhnkmmkk.co.jp
set USER       keikibu
set PASSWORD   keikipafe
set REMOTEDIR  ~/local/tomcat/logs

cd C:/temp

set con [::ftp::Open $REMOTEHOST $USER $PASSWORD]
puts "接続されました。$con"
::ftp::Type $con binary

::ftp::Cd $con $REMOTEDIR
::ftp::Get $con catalina.out
set datestr [clock format [clock seconds] -format "%Y-%m-%d"]
::ftp::Get $con shitenapp01.$datestr.txt

exec cmd /c catalina.out &
exec cmd /c shitenapp01.$datestr.txt &

::ftp::Close $con

「cmd /c ファイル名」というのは、Windows環境ならではの裏技で、 ファイル名の拡張子に「関連付け」されたアプリケーションが自動的に起動されます。 アプリケーションのパスを指定しなくてもいいので大変便利です。

拡張レビュー分室 top
(first uploaded 2001/06/01 last updated 2006/07/09, MISUMI URANO - YUKO AMEMIYA)