Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling

Putty Session Generator

by d_jabsd (Acolyte)
on Oct 21, 2004 at 16:10 UTC ( #401207=sourcecode: print w/replies, xml ) Need Help??
Category: Win32 Stuff
Author/Contact Info Daniel Schrock
Description: This script will parse a config file and generate registry keys and shortcuts that you can add to your taskbar for easy access to saved putty sessions. Any and all comments/enhancements are welcome. I use this site extensively, so I figured its time I give something back. Although the script isn't perfect, it works well for me and can be easily modified to accomodate your personal setup. Enjoy.
The code:
#!/usr/bin/perl -w
# written by Daniel Schrock 
# ver. 0.1 - 03/17/04 - initial testing and dev.
# ver. 0.2 - 04/23/04 - First working version
# Requirements:
#  -ActiveState Perl 5.8.2 or higher
#  -Win32::TieRegistry module (use ppm or CPAN)
#  -Win32::Shortcut (use ppm or CPAN)
use strict 'vars';

my $Registry;

use Win32::TieRegistry( TiedRef => \$Registry, Delimiter=>"/", qw( REG
use Win32::Shortcut;

#my $print_output="notTRUE";
my $print_output="TRUE";
my $ignore='^\s*#|^\s*\n\r*';

my $base_dir= "c:/NoInstall";
my $user;
my $netuser= "admin";
my $sshuser= $ARGV[0]||"";
my $tmpuser;
my $server_list= "$base_dir/servers.txt";
my $folder;
my $protocol;
my $protover;
my $version;
my $session_name;
my $server_name;
my $app="putty.exe";
my $appdir="$base_dir/$app";
my $dest_dir="$base_dir/putty-sessions";
my $LINK;
my $RegPath= "CUser/Software/SimonTatham/PuTTY/Sessions/";
my $hexport;
my $protoport;
my $compr;
my $protocompr;


open(SERVER_LIST,$server_list)||die "Can't open $server_list: $!\n";
while (<SERVER_LIST>) {
    next if /$ignore/ ;
    ( $folder, $server_name, $session_name, $protocol)= split (":");
    &create_session($server_name, $session_name, $protocol, $user);
    &create_link($folder, $server_name, $session_name);

sub check_putty_exe
    if (! -f "$appdir" )
    { print "$appdir not found!\n\n Unable to continue!\n\n Please mov
+e/copy $app into $base_dir and rerun this script\n";
    exit 1;
     print "Excellent! Found $app in $base_dir\n"; 

sub check_putty_session_dir
    if (! -d "$dest_dir" ) {
        print "$dest_dir not found.\nCreating $dest_dir\n";
        mkdir $dest_dir || die "Error! Can not create $dest_dir";
        print "$dest_dir found.\nCreating a backup\n";
        if ( -d "$dest_dir.bak" ) {
            print "Found previous backup.\nPlease remove and rerun the
+ script.\n";
            exit 1;
        rename $dest_dir, $dest_dir.'.bak' || die "Couldn't backup $de
        print "Backup created.\n\( $dest_dir.bak \)\nCreating new sess
+ion directory\n\n";
        mkdir $dest_dir  || die "Error! Can not create $dest_dir";
        print "New session directory created.\n\( $dest_dir \)\n";

sub create_port
    if ( $protocol eq "telnet" )
    {    $protoport= "0x00017";
        $protover= "0x00003";
        $protocompr= "0x00000";
    }elsif ( $protocol eq "ssh2" )
    {    $protoport= "0x00016";
        $protover= "0x00003";
        $protocompr= "0x00001";
    }elsif ( $protocol eq "ssh1" )
    {    $protoport= "0x00016";
        $protover= "0x00002";
        $protocompr= "0x00000";
    return ($protoport, $protover, $protocompr);

sub create_user
    if ( $folder eq "network" || $folder eq "frame" || $folder eq "s2s
+-vpn" )
        $tmpuser= $netuser;
        $tmpuser= $sshuser;
sub create_link
    if (! -d "$dest_dir/$folder" )
        mkdir "$dest_dir/$folder" || die "Error! Can not create $dest_
    $LINK=new Win32::Shortcut();
    $LINK->{'Arguments'}="-load $session_name";
    print "$dest_dir/$folder/$session_name.lnk created.\n"

sub create_session
    $Registry->{"$RegPath"}= {
        "$session_name/" => {
            "/HostName" => "$server_name",
            "/Protocol" => "$protocol",
            "/PortNumber" => ["$hexport", REG_DWORD ],
            "/PingIntervalSecs" => [ "0x0001", REG_DWORD ],
            "/TCPNoDelay" => [ "0x0000", REG_DWORD ],
            "/UserName" => "$user",
            "/Compression" => [ "$compr", REG_DWORD ],
            "/Cipher" => "blowfish,aes,3des,WARN,des",
            "/SshProt" => [ "$version", REG_DWORD ],
            "/LinuxFunctionKeys" => [ "0x0002", REG_DWORD ],
            "/BLinkCur" => [ "0x0001", REG_DWORD ],
            "/ScrollbackLines" => [ "0x07d0", REG_DWORD ],
    } || die "Can't create $RegPath/$session_name: $^E\n";
The Config File:
After running, just create a new toolbar that points to the putty-sessions folder.
Replies are listed 'Best First'.
Re: Putty Session Generator
by clscott (Friar) on Oct 21, 2004 at 17:14 UTC

    Very cool ++; I think I will find this useful at work.

    Thanks for taking the the time to decode the Registry

    I don't understand what you mean by "create a new toolbar." A new toolbar in what application?

      in Windows XP/2k3... might work in 2k as well... just right click your taskbar, select Toolbars, then New Toolbar and find the putty-sessions folder.
Re: Putty Session Generator
by thor (Priest) on Oct 24, 2004 at 13:19 UTC
    I think I might use this once I disect it and (possibly) clean it up. Please take the following as instructive and not as derisive.

    A couple of things that jumped out at me:

    • use strict 'vars'; Usually one needs a pretty good reason to enable only some of the strictitures. As it turns out, your code runs under full strict mode.
    • You're not passing variables to subs. You might think that you are with calls like $user=create_user($folder);, but the create_user sub (and all the others) use $folder (and the rest of the variables) in a global sense. This is usually considered bad form.
    I might try using your script as a base for creating one that does the same thing, but using an XML file as a config so that you only have to specify the values that are not the default value. Plus, it would give me an excuse to learn perlXML...;). This is a great idea!


    Feel the white light, the light within
    Be your own disciple, fan the sparks of will
    For all of us waiting, your kingdom will come

      Thanks for your input, thor! I'm still trying to get a handle on the intricacies of Perl, so all advice is greatly appreciated.
      Just to clarify, I can replace  use strict 'vars'; with  use strict; ?
      Could you explain item 2 a bit further, or point me to something that might help me fix it?
        Just to clarify, I can replace use strict 'vars'; with use strict; ?
        For this script, you can. I find that coding under the full strictitures keeps me from doing things that I probably didn't mean, and is not that much harder than doing so without.
        Could you explain item 2 a bit further, or point me to something that might help me fix it?
        Sure. You're calling subs right now like mysub($foo, $bar) where the definition of mysub is something like
        sub mysub { $foo ++; some_other_sub($bar); }
        It should read like this:
        sub mysub { my ($foo, $bar) = @_; #do stuff with $foo and $bar }
        This allows you to follow another maxim that should be adhered to in general: declare your variables in the tightest scope that you can. That is to say that if you're using a while loop and some values only hold true for only that iteration of the while loop, you should declare them within the scope of that loop. For a concrete example from your code:
        my ($folder, $server_name, $session_name, $protocol, $hexport, $version, $compr, $user); while (<SERVER_LIST>) { next if /$ignore/ ; chop; ( $folder, $server_name, $session_name, $protocol)= split (":"); ($hexport,$version,$compr)=create_port($protocol); $user=create_user($folder); &create_session($server_name, $session_name, $protocol, $user); &create_link($folder, $server_name, $session_name); }
        becomes (with some other differences sprinkled in)
        while (<SERVER_LIST>) { next if /$ignore/ ; # chomp is safer than the perldoc for # both of those functions (perldoc -f chop for chop chomp; my ($folder, $server_name, $session_name, $protocol)= split (":"); my ($hexport,$version,$compr)=create_port($protocol); my $user=create_user($folder); # the &sub syntax is not advised in most situations for reasons # that are slightly advanced, sub() suffices create_session($server_name, $session_name, $protocol, $user); create_link($folder, $server_name, $session_name); }
        I didn't look too carefully at the code that is called by this block, but I'm pretty sure that the subs create_session and create_link would have to be altered in such a way as to not use global variables to store their information.

        I hope this helps. If you have more questions, feel free to ask. I'm more than happy to help!


        Feel the white light, the light within
        Be your own disciple, fan the sparks of will
        For all of us waiting, your kingdom will come

Log In?

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://401207]
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (3)
As of 2022-08-18 17:54 GMT
Find Nodes?
    Voting Booth?

    No recent polls found